471 lines
16 KiB
Common Lisp
471 lines
16 KiB
Common Lisp
; ============================================================
|
||
; 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 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))
|
||
(cond
|
||
((or
|
||
(wcmatch third "TPE*")
|
||
(wcmatch third "PE*")
|
||
(wcmatch third "LPE*")
|
||
(wcmatch third "RPE*")
|
||
)
|
||
(setq kind "TPE")
|
||
(setq idx
|
||
(cond
|
||
((wcmatch third "TPE*") (atoi (substr third 4)))
|
||
((wcmatch third "LPE*") (atoi (substr third 4)))
|
||
((wcmatch third "RPE*") (atoi (substr third 4)))
|
||
(T (atoi (substr third 3))) ; PE*
|
||
)
|
||
)
|
||
)
|
||
((wcmatch third "EPC*") (setq kind "EPC") (setq idx (atoi (substr third 4))))
|
||
((wcmatch third "VFD*") (setq kind "VFD") (setq idx (atoi (substr third 4))))
|
||
(t (setq kind nil) (setq idx 0))
|
||
)
|
||
(if (and kind prefix (> section 0) (> idx 0))
|
||
(list prefix section kind idx)
|
||
nil
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
nil
|
||
)
|
||
)
|
||
|
||
(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 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 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)
|
||
|
||
(setq tpeMap '())
|
||
(setq epcMap '())
|
||
(setq vfdPresence '())
|
||
|
||
(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_EPC") (= effName "VFD_V2"))
|
||
(progn
|
||
(setq attList (vlax-invoke blk 'GetAttributes))
|
||
(setq ptag (getAttVal attList "P_TAG1"))
|
||
(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) entries))
|
||
(setq tpeMap
|
||
(if (assoc key tpeMap)
|
||
(subst (cons key entries) (assoc key tpeMap) tpeMap)
|
||
(cons (cons key entries) tpeMap))
|
||
)
|
||
)
|
||
((= 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 '()))
|
||
(setq entries (cons (list idx xy) 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") "conveyors.csv")
|
||
"csv" 1))
|
||
(if outPath
|
||
(progn
|
||
(setq fh (open outPath "w"))
|
||
(write-line "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" 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
|
||
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
|
||
key "," (itoa secNum) ","
|
||
(itoa included) "," reason ","
|
||
(itoa hasT) "," (itoa hasE) "," (itoa hasV) ","
|
||
(itoa isLastAny) "," (itoa isLastGeom) ",,,,"
|
||
)
|
||
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)
|