; ============================================================ ; EXPORT_CONVEYORS (v7 - TPE-first geometry + EPC bootstrap + VFD inclusion + reasoning columns) ; ; Output: CSV ; conveyor_key,sec,included,reason,has_tpe,has_epc,has_vfd,is_last_any,is_last_geom,start_x,start_y,end_x,end_y ; ; included: ; 1 = geometry exported (TPE-based) ; 0 = no geometry (typically VFD-only) ; ; reasoning columns help Godot decide: ; - "VFD_ONLY_MIDDLE" => likely spur candidate (not last in prefix) ; - "VFD_ONLY_LAST_MAY_MERGE" => last in prefix, could be merge-end triangle conveyor ; - "VFD_ONLY_BEFORE_GEOM_END"=> weird: VFD-only but section <= last geom section (data issue / missing TPE) ; - "NO_GEOM_NO_VFD" => not written (we don’t export these) ; ============================================================ (vl-load-com) (setq *MAX_STITCH_DISTANCE* 1000.0) ; inches (setq *MAX_BOOTSTRAP_DISTANCE* 5000.0) ; inches (defun getAttVal (attList tag) (setq tag (strcase tag)) (setq a (vl-some '(lambda (a) (if (= (strcase (vla-get-tagstring a)) tag) a)) attList)) (if a (strcase (vl-string-trim " " (vla-get-textstring a))) "" ) ) (defun splitUnderscore (s / parts cur i ch) (setq parts '() cur "" i 1) (while (<= i (strlen s)) (setq ch (substr s i 1)) (if (= ch "_") (progn (setq parts (append parts (list cur))) (setq cur "")) (setq cur (strcat cur ch))) (setq i (1+ i))) (append parts (list cur)) ) (defun getDynPropVal (blk propName / props p n raw v) (setq propName (strcase propName)) (setq v nil) (if (= :vlax-true (vla-get-isdynamicblock blk)) (progn (setq props (vlax-invoke blk 'GetDynamicBlockProperties)) (foreach p props (setq n (strcase (vla-get-propertyname p))) (if (= n propName) (progn (setq raw (vlax-variant-value (vla-get-value p))) (if (numberp raw) (setq v raw)) ) ) ) ) ) v ) (defun parse-ptag1-anchor (ptag / s parts prefix section third kind idx) (setq s (strcase (vl-string-trim " " ptag))) (if (and s (vl-string-search "_" s)) (progn (setq parts (splitUnderscore s)) (if (>= (length parts) 3) (progn (setq prefix (nth 0 parts)) (setq section (atoi (nth 1 parts))) (setq third (nth 2 parts)) (setq kind nil idx 1) (cond ((or (wcmatch third "TPE*") (wcmatch third "PE*") (wcmatch third "LPE*") (wcmatch third "RPE*")) (setq kind "TPE") (setq idx (atoi (substr third 4))) ) ((wcmatch third "EPC*") (setq kind "EPC") (setq idx (atoi (substr third 4)))) ((wcmatch third "SS*") (setq kind "SS") (setq idx (atoi (substr third 3)))) ((wcmatch third "S*") (setq kind "BTN") (setq idx (atoi (substr third 2)))) ((wcmatch third "BCN*") (setq idx (atoi (substr third 4))) (if (and (>= (length parts) 4) (= (nth 3 parts) "H")) (setq kind "HORN") (setq kind "BCN") ) ) ((wcmatch third "VFD*") (setq kind "VFD") (setq idx (atoi (substr third 4)))) ) (if (and kind prefix (> section 0)) (list prefix section kind idx) ) ) ) ) ) ) (defun parse-key (key / parts prefix section) (setq parts (splitUnderscore (strcase key))) (if (= (length parts) 2) (progn (setq prefix (nth 0 parts)) (setq section (atoi (nth 1 parts))) (if (and prefix (> section 0)) (list prefix section) nil))) ) (defun PI () (* 4.0 (atan 1.0))) (defun rad->deg (r) (* r (/ 180.0 (PI))) ) (defun tpe-rot-deg (raw / v) ;; raw may already be degrees in some blocks, or radians in others. ;; Heuristic: if abs(v) <= ~2π it's radians, else it's degrees. (setq v raw) (if (and (numberp v) (<= (abs v) (* 2.0 (PI)))) (rad->deg v) v ) ) (defun dist2d (p q / dx dy) (setq dx (- (car p) (car q))) (setq dy (- (cadr p) (cadr q))) (sqrt (+ (* dx dx) (* dy dy))) ) (defun within? (p q maxd) (and p q (<= (dist2d p q) maxd)) ) (defun find-by-section (chain targetSec / r) (setq r nil) (foreach e chain (if (= (car e) targetSec) (setq r e))) r ) (defun farthest-from (pts ref / bestD bestP d) (setq bestD -1.0 bestP nil) (foreach p pts (setq d (dist2d p ref)) (if (> d bestD) (setq bestD d bestP p))) bestP ) ;; prefixStats = ( (prefix . (maxAny maxGeom)) ... ) (defun stats-get (stats prefix / it) (setq it (assoc prefix stats)) (if it (cdr it) (list 0 0)) ) (defun stats-set (stats prefix maxAny maxGeom / it) (setq it (assoc prefix stats)) (if it (subst (cons prefix (list maxAny maxGeom)) it stats) (cons (cons prefix (list maxAny maxGeom)) stats) ) ) (defun block-rot-deg (blk / r) (setq r (vla-get-rotation blk)) ; radians (rad->deg r) ) (defun c:EXPORT_CONVEYORS ( / ss i ent blk effName attList ptag parsed prefix section kind idx insPt xy key tpeMap epcMap vfdPresence outPath fh chainMap kv parsedKey chainKey secNum tpeEntries epcEntries tpeCount epcPoints tpeSorted firstTPE lastTPE chains rec prevRec prevEnd startXY endXY allKeys endRef baseLen epcCandidate epcLen included prefixStats maxAny maxGeom hasT hasE hasV isLastAny isLastGeom reason btnMap beaconMap hornMap ssMap) (setq tpeMap '()) (setq epcMap '()) (setq vfdPresence '()) (setq btnMap '()) (setq beaconMap '()) (setq hornMap '()) (setq ssMap '()) (setq ss (ssget "X" '((0 . "INSERT")))) (if (not ss) (progn (princ "\nNo INSERT blocks found.") (princ)) (progn ;; --- 1) Collect anchors + VFD presence --- (setq i 0) (while (< i (sslength ss)) (setq ent (ssname ss i)) (setq blk (vlax-ename->vla-object ent)) (setq effName (strcase (vla-get-EffectiveName blk))) (if (or (= effName "CLX_TPE") (= effName "CLX_TPE1") (= effName "CLX_EPC") (= effName "VFD_V2") (= effName "CLX_GS") (= effName "CLX_GS1") (= effName "CLX_LT") (= effName "CLX_LT1") (= effName "AS_LTH") (= effName "CLX_SS_1") ) (progn (setq attList (vlax-invoke blk 'GetAttributes)) (setq ptag (getAttVal attList "P_TAG1")) (setq tpeRotRaw (getDynPropVal blk "PE ROTATION")) (setq tpeRot (tpe-rot-deg tpeRotRaw)) (if (not (numberp tpeRot)) (setq tpeRot 0.0)) (setq tpeDist (getDynPropVal blk "Distance1")) (if (not (numberp tpeDist)) (setq tpeDist 0.0)) (setq blkRot (block-rot-deg blk)) (if (not (numberp blkRot)) (setq blkRot 0.0)) (setq parsed (parse-ptag1-anchor ptag)) (if parsed (progn (setq prefix (nth 0 parsed)) (setq section (nth 1 parsed)) (setq kind (nth 2 parsed)) (setq idx (nth 3 parsed)) (setq key (strcat prefix "_" (itoa section))) (cond ((= kind "TPE") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key tpeMap))) (if (not entries) (setq entries '())) (setq entries (cons (list idx xy ptag tpeRot blkRot tpeDist) entries)) (setq tpeMap (if (assoc key tpeMap) (subst (cons key entries) (assoc key tpeMap) tpeMap) (cons (cons key entries) tpeMap)) ) ) ;; >>> BUTTONS ((= kind "BTN") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key btnMap))) (if (not entries) (setq entries '())) (setq entries (cons (list idx xy ptag) entries)) (setq btnMap (if (assoc key btnMap) (subst (cons key entries) (assoc key btnMap) btnMap) (cons (cons key entries) btnMap)) ) ) ;; >>> BEACONS ((= kind "BCN") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key beaconMap))) (if (not entries) (setq entries '())) (setq entries (cons (list idx xy ptag) entries)) (setq beaconMap (if (assoc key beaconMap) (subst (cons key entries) (assoc key beaconMap) beaconMap) (cons (cons key entries) beaconMap)) ) ) ;; >>> HORN BEACONS (AS_LTH) ((= kind "HORN") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key hornMap))) (if (not entries) (setq entries '())) (setq entries (cons (list idx xy ptag) entries)) (setq hornMap (if (assoc key hornMap) (subst (cons key entries) (assoc key hornMap) hornMap) (cons (cons key entries) hornMap)) ) ) ;; >>> START/STOP STATIONS ((= kind "SS") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key ssMap))) (if (not entries) (setq entries '())) (setq entries (cons (list idx xy ptag) entries)) (setq ssMap (if (assoc key ssMap) (subst (cons key entries) (assoc key ssMap) ssMap) (cons (cons key entries) ssMap)) ) ) ((= kind "EPC") (setq insPt (vlax-get blk 'InsertionPoint)) (setq xy (list (car insPt) (cadr insPt))) (setq entries (cdr (assoc key epcMap))) (if (not entries) (setq entries '())) ;; now storing ptag as well (setq entries (cons (list idx xy ptag) entries)) (setq epcMap (if (assoc key epcMap) (subst (cons key entries) (assoc key epcMap) epcMap) (cons (cons key entries) epcMap)) ) ) ((= kind "VFD") (if (not (assoc key vfdPresence)) (setq vfdPresence (cons (cons key T) vfdPresence))) ) ) ) ) ) ) (setq i (1+ i)) ) ;; --- 2) Build chainMap by prefix for conveyors with TPEs --- (setq chainMap '()) (setq allKeys '()) ;; union keys: tpe keys + epc-only keys (for bootstrap availability) (foreach kv tpeMap (setq allKeys (cons (car kv) allKeys))) (foreach kv epcMap (if (not (assoc (car kv) tpeMap)) (setq allKeys (cons (car kv) allKeys)))) (foreach key allKeys (setq parsedKey (parse-key key)) (if parsedKey (progn (setq chainKey (nth 0 parsedKey)) (setq secNum (nth 1 parsedKey)) (setq tpeEntries (cdr (assoc key tpeMap))) (setq epcEntries (cdr (assoc key epcMap))) (setq tpeCount (if tpeEntries (length tpeEntries) 0)) (setq epcPoints '()) (if epcEntries (foreach it epcEntries (setq epcPoints (cons (cadr it) epcPoints)))) (if (> tpeCount 0) (progn (setq tpeSorted (vl-sort tpeEntries '(lambda (a b) (< (car a) (car b))))) (setq firstTPE (cadr (car tpeSorted))) (setq lastTPE (cadr (car (reverse tpeSorted)))) (setq rec (list secNum key tpeCount tpeSorted firstTPE lastTPE epcPoints)) (setq chains (cdr (assoc chainKey chainMap))) (if (not chains) (setq chains '())) (setq chains (cons rec chains)) (setq chainMap (if (assoc chainKey chainMap) (subst (cons chainKey chains) (assoc chainKey chainMap) chainMap) (cons (cons chainKey chains) chainMap))) ) ) ) ) ) ;; sort by section (foreach kv chainMap (setq chainKey (car kv)) (setq chains (vl-sort (cdr kv) '(lambda (a b) (< (car a) (car b))))) (setq chainMap (subst (cons chainKey chains) kv chainMap)) ) ;; --- 2.5) Build prefixStats: maxAny and maxGeom per prefix --- (setq prefixStats '()) ;; consider ANY keys from: tpeMap, epcMap, vfdPresence (foreach kv tpeMap (setq key (car kv)) (setq parsedKey (parse-key key)) (if parsedKey (progn (setq prefix (nth 0 parsedKey)) (setq secNum (nth 1 parsedKey)) (setq it (stats-get prefixStats prefix)) (setq maxAny (nth 0 it)) (setq maxGeom (nth 1 it)) (if (> secNum maxAny) (setq maxAny secNum)) (if (> secNum maxGeom) (setq maxGeom secNum)) (setq prefixStats (stats-set prefixStats prefix maxAny maxGeom)) ) ) ) (foreach kv epcMap (setq key (car kv)) (setq parsedKey (parse-key key)) (if parsedKey (progn (setq prefix (nth 0 parsedKey)) (setq secNum (nth 1 parsedKey)) (setq it (stats-get prefixStats prefix)) (setq maxAny (nth 0 it)) (setq maxGeom (nth 1 it)) (if (> secNum maxAny) (setq maxAny secNum)) ;; maxGeom only updates via TPE (geometry), so leave it (setq prefixStats (stats-set prefixStats prefix maxAny maxGeom)) ) ) ) (foreach kv vfdPresence (setq key (car kv)) (setq parsedKey (parse-key key)) (if parsedKey (progn (setq prefix (nth 0 parsedKey)) (setq secNum (nth 1 parsedKey)) (setq it (stats-get prefixStats prefix)) (setq maxAny (nth 0 it)) (setq maxGeom (nth 1 it)) (if (> secNum maxAny) (setq maxAny secNum)) (setq prefixStats (stats-set prefixStats prefix maxAny maxGeom)) ) ) ) ;; --- 3) Write CSV --- (setq outPath (getfiled "Save conveyors CSV" (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) ".csv" ) "csv" 1 ) ) (if outPath (progn (setq fh (open outPath "w")) ;; >>> ADDED: record_type + TPE columns (write-line "record_type,conveyor_key,sec,included,reason,has_tpe,has_epc,has_vfd,is_last_any,is_last_geom,start_x,start_y,end_x,end_y,tpe_name,tpe_x,tpe_y,tpe_rotation,tpe_block_rotation,tpe_distance,dev_name,dev_x,dev_y" fh) ;; --- 3A) Geometry conveyors (included=1) --- (foreach kv chainMap (setq chainKey (car kv)) (setq chains (cdr kv)) ;; prefix stats for flags (setq it (stats-get prefixStats chainKey)) (setq maxAny (nth 0 it)) (setq maxGeom (nth 1 it)) (foreach rec chains (setq secNum (nth 0 rec)) (setq key (nth 1 rec)) (setq tpeCount (nth 2 rec)) (setq firstTPE (nth 4 rec)) (setq lastTPE (nth 5 rec)) (setq epcPoints (nth 6 rec)) (setq startXY firstTPE) (setq endXY lastTPE) (setq prevRec (find-by-section chains (1- secNum))) ;; single-TPE handling (if (= tpeCount 1) (progn (setq endXY lastTPE) (if prevRec (progn (setq prevEnd (nth 5 prevRec)) (if (within? prevEnd endXY *MAX_STITCH_DISTANCE*) (setq startXY prevEnd) (setq startXY endXY))) (setq startXY endXY)) ;; EPC bootstrap only if first in chain (if (and (not prevRec) epcPoints) (progn (setq epcCandidate (farthest-from epcPoints endXY)) (if (and epcCandidate (within? epcCandidate endXY *MAX_BOOTSTRAP_DISTANCE*)) (setq startXY epcCandidate)))) ) ) ;; multi-TPE bootstrap only if first in chain (if (and (>= tpeCount 2) (not prevRec) epcPoints) (progn (setq endRef lastTPE) (setq baseLen (dist2d firstTPE endRef)) (setq epcCandidate (farthest-from epcPoints endRef)) (if (and epcCandidate (> (dist2d epcCandidate endRef) baseLen) (within? epcCandidate endRef *MAX_BOOTSTRAP_DISTANCE*)) (setq startXY epcCandidate))) ) (setq included 1) (setq hasT 1) (setq hasE (if (assoc key epcMap) 1 0)) (setq hasV (if (assoc key vfdPresence) 1 0)) (setq isLastAny (if (= secNum maxAny) 1 0)) (setq isLastGeom (if (= secNum maxGeom) 1 0)) (setq reason "GEOMETRY") (write-line (strcat "CONVEYOR," ;; >>> ADDED key "," (itoa secNum) "," (itoa included) "," reason "," (itoa hasT) "," (itoa hasE) "," (itoa hasV) "," (itoa isLastAny) "," (itoa isLastGeom) "," (rtos (car startXY) 2 6) "," (rtos (cadr startXY) 2 6) "," (rtos (car endXY) 2 6) "," (rtos (cadr endXY) 2 6) ) fh ) ) ) ;; --- 3B) VFD-only conveyors (included=0, no geometry) --- (foreach kv vfdPresence (setq key (car kv)) (setq parsedKey (parse-key key)) ;; only output if no TPE geometry record exists (if (and parsedKey (not (assoc key tpeMap))) (progn (setq prefix (nth 0 parsedKey)) (setq secNum (nth 1 parsedKey)) (setq it (stats-get prefixStats prefix)) (setq maxAny (nth 0 it)) (setq maxGeom (nth 1 it)) (setq included 0) (setq hasT 0) (setq hasE (if (assoc key epcMap) 1 0)) (setq hasV 1) (setq isLastAny (if (= secNum maxAny) 1 0)) (setq isLastGeom (if (= secNum maxGeom) 1 0)) ;; Reasoning: ;; - If this is last of the prefix (maxAny): could be a merge-end “triangle” conveyor ;; - If it’s not last: likely a side spur candidate ;; - If it’s before/at last geom section: likely missing TPEs / drafting inconsistency (setq reason "VFD_ONLY_MIDDLE") (if (= isLastAny 1) (setq reason "VFD_ONLY_LAST_MAY_MERGE") (if (and (> maxGeom 0) (<= secNum maxGeom)) (setq reason "VFD_ONLY_BEFORE_GEOM_END") ) ) (write-line (strcat "CONVEYOR," ;; >>> ADDED key "," (itoa secNum) "," (itoa included) "," reason "," (itoa hasT) "," (itoa hasE) "," (itoa hasV) "," (itoa isLastAny) "," (itoa isLastGeom) ",,,," ) fh ) ) ) ) ;; ============================================================ ;; 3C) TPE records ;; ============================================================ ;; record_type = TPE ;; sec column intentionally left EMPTY ;; ============================================================ (foreach kv tpeMap (setq key (car kv)) (foreach it (cdr kv) (setq idx (nth 0 it)) (setq xy (nth 1 it)) (setq tpeName (nth 2 it)) (setq tpeRot (nth 3 it)) (setq blkRot (nth 4 it)) (setq tpeDist (nth 5 it)) (write-line (strcat "TPE," ;; record_type key "," ;; conveyor_key "," ;; sec (INTENTIONALLY EMPTY) ",,,,,,,," ;; conveyor-only fields "," "," "," ;; start_x,start_y,end_x,end_y empty tpeName "," ;; tpe_name (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) "," (rtos tpeRot 2 6) "," (rtos blkRot 2 6) "," (if tpeDist (rtos tpeDist 2 6) "") ) fh ) ) ) ;; --- START STOP STATIONS --- (foreach kv ssMap (setq key (car kv)) (foreach it (cdr kv) (setq xy (nth 1 it)) (setq devName (nth 2 it)) (write-line (strcat "SS," key ",,,,,,,,,,,,,,,,,,," devName "," (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) ) fh ) ) ) ;; --- BUTTONS --- (foreach kv btnMap (setq key (car kv)) (foreach it (cdr kv) (setq xy (nth 1 it)) (setq devName (nth 2 it)) (write-line (strcat "S," key ",,,,,,,,,,,,,,,,,,," devName "," (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) ) fh ) ) ) ;; --- BEACONS --- (foreach kv beaconMap (setq key (car kv)) (foreach it (cdr kv) (setq xy (nth 1 it)) (setq devName (nth 2 it)) (write-line (strcat "BCN," key ",,,,,,,,,,,,,,,,,,," devName "," (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) ) fh ) ) ) ;; --- HORN BEACONS --- (foreach kv hornMap (setq key (car kv)) (foreach it (cdr kv) (setq xy (nth 1 it)) (setq devName (nth 2 it)) (write-line (strcat "BCN," key ",,,,,,,,,,,,,,,,,,," devName "," (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) ) fh ) ) ) ;; --- EPC DEVICES --- (foreach kv epcMap (setq key (car kv)) (foreach it (cdr kv) (setq xy (nth 1 it)) (setq devName (nth 2 it)) (write-line (strcat "EPC," key ",,,,,,,,,,,,,,,,,,," ;; up to tpe_distance (19 empty fields) devName "," (rtos (car xy) 2 6) "," (rtos (cadr xy) 2 6) ) fh ) ) ) (close fh) (princ (strcat "\nExported conveyors to: " outPath)) (princ "\nIncluded=1 => geometry. Included=0 => VFD-only (no TPE geometry).") (princ "\nReason + is_last_* columns added to support spur/merge rules in Godot.") ) ) ) ) (princ) ) (princ "\nLoaded. Run command: EXPORT_CONVEYORS") (princ)