485 lines
16 KiB
Common Lisp
485 lines
16 KiB
Common Lisp
; ============================================================
|
|
; EXPORT_CONVEYORS (v5 - TPE-first geometry + EPC bootstrap only at chain start + VFD count)
|
|
;
|
|
; Conveyor definition:
|
|
; - Source blocks:
|
|
; CLX_TPE (photoeye anchors)
|
|
; CLX_EPC (EPC blocks - may be chained across multiple conveyors)
|
|
; VFD_v2 (drive blocks)
|
|
; - Logical name from attribute: P_TAG1
|
|
; e.g. UL5_4_TPE1, UL6_2_EPC2, UL6_3_VFD1
|
|
; - Conveyor key = <Prefix>_<Section>
|
|
; - Section change ALWAYS = new conveyor
|
|
;
|
|
; GEOMETRY (IMPORTANT):
|
|
; - TPEs define conveyor boundaries. EPCs DO NOT split conveyors.
|
|
; - For each conveyor key:
|
|
; * If TPE count >= 2:
|
|
; end = last TPE (highest index)
|
|
; start = first TPE (lowest index)
|
|
; BUT if this is the first conveyor in the prefix chain (no previous section exported)
|
|
; and EPC exists on this conveyor, EPC may be used as the START ONLY (bootstrap) if it extends the belt.
|
|
; * If TPE count == 1:
|
|
; end = that single TPE
|
|
; start = previous conveyor end (if exists & within MAX_STITCH_DISTANCE)
|
|
; else (ONLY if first conveyor in chain) bootstrap start from EPC farthest from the end TPE
|
|
; else start = own TPE
|
|
; * If TPE count == 0:
|
|
; not exported (out of scope / unreliable geometry)
|
|
;
|
|
; Output: CSV
|
|
; conveyor_key,tpe_count,vfd_count,start_x,start_y,end_x,end_y
|
|
; ============================================================
|
|
|
|
(vl-load-com)
|
|
|
|
;; ------------------------
|
|
;; Tuning / safety
|
|
;; ------------------------
|
|
(setq *MAX_STITCH_DISTANCE* 1000.0) ; inches (normal neighbor stitching)
|
|
(setq *MAX_BOOTSTRAP_DISTANCE* 5000.0) ; inches (EPC bootstrap guardrail for FIRST conveyor only)
|
|
|
|
;; ------------------------
|
|
;; Attribute helper
|
|
;; ------------------------
|
|
(defun getAttVal (attList tag)
|
|
(setq tag (strcase tag))
|
|
(setq a
|
|
(vl-some
|
|
(function
|
|
(lambda (a)
|
|
(if (= (strcase (vla-get-tagstring a)) tag) a)
|
|
)
|
|
)
|
|
attList
|
|
)
|
|
)
|
|
(if a
|
|
(strcase (vl-string-trim " " (vla-get-textstring a)))
|
|
""
|
|
)
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Simple underscore splitter
|
|
;; ------------------------
|
|
(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))
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Parse P_TAG1 like: UL6_3_TPE1 / UL6_3_EPC2 / UL6_3_VFD1
|
|
;; returns: (prefix section kind index) or nil
|
|
;; kind is "TPE" / "EPC" / "VFD"
|
|
;; ------------------------
|
|
(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)) ; TPE#, EPC#, VFD#
|
|
|
|
(cond
|
|
((wcmatch third "TPE*")
|
|
(setq kind "TPE")
|
|
(setq idx (atoi (substr third 4))))
|
|
((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
|
|
)
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Helpers: key parsing + distance
|
|
;; ------------------------
|
|
(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
|
|
)
|
|
)
|
|
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))
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Find neighbor record in a chain (by prefix + section)
|
|
;; Each chain entry:
|
|
;; (section key tpeCount tpeSorted firstTPE lastTPE epcPoints)
|
|
;; ------------------------
|
|
(defun find-by-section (chain targetSec / r)
|
|
(setq r nil)
|
|
(foreach e chain
|
|
(if (= (car e) targetSec) (setq r e))
|
|
)
|
|
r
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Pick EPC point farthest from a reference point (usually endTPE)
|
|
;; Returns EPC xy or nil
|
|
;; ------------------------
|
|
(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)
|
|
(progn
|
|
(setq bestD d)
|
|
(setq bestP p)
|
|
)
|
|
)
|
|
)
|
|
bestP
|
|
)
|
|
|
|
;; ------------------------
|
|
;; Main command
|
|
;; ------------------------
|
|
(defun c:EXPORT_CONVEYORS ( / ss i ent blk effName attList ptag parsed
|
|
prefix section kind idx insPt xy key
|
|
tpeMap epcMap vfdMap entries
|
|
outPath fh
|
|
chainMap kv parsedKey chainKey secNum
|
|
tpeEntries epcEntries tpeCount epcPoints
|
|
tpeSorted firstTPE lastTPE
|
|
chains rec
|
|
prevRec prevEnd
|
|
startXY endXY
|
|
vfdEntries vfdCount
|
|
allKeys
|
|
endRef baseLen epcCandidate epcLen)
|
|
|
|
;; Maps:
|
|
;; tpeMap = ( (key . ( (idx xy) ... )) ... )
|
|
;; epcMap = ( (key . ( (idx xy) ... )) ... )
|
|
;; vfdMap = ( (key . ( "UL6_3_VFD1" ... )) ... ) ; unique P_TAG1 values
|
|
(setq tpeMap '())
|
|
(setq epcMap '())
|
|
(setq vfdMap '())
|
|
|
|
(setq ss (ssget "X" '((0 . "INSERT"))))
|
|
|
|
(if (not ss)
|
|
(progn
|
|
(princ "\nNo INSERT blocks found.")
|
|
(princ)
|
|
)
|
|
(progn
|
|
;; ------------------------
|
|
;; 1) Collect TPE + EPC points + VFD unique tags by conveyor key
|
|
;; ------------------------
|
|
(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)))
|
|
|
|
;; VFD_v2 -> "VFD_V2"
|
|
(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
|
|
;; --- TPE ---
|
|
((= 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)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; --- EPC ---
|
|
((= 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)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; --- VFD (unique by P_TAG1 text) ---
|
|
((= kind "VFD")
|
|
(setq vfdEntries (cdr (assoc key vfdMap)))
|
|
(if (not vfdEntries) (setq vfdEntries '()))
|
|
(if (and (/= ptag "") (not (member ptag vfdEntries)))
|
|
(setq vfdEntries (cons ptag vfdEntries))
|
|
)
|
|
(setq vfdMap
|
|
(if (assoc key vfdMap)
|
|
(subst (cons key vfdEntries) (assoc key vfdMap) vfdMap)
|
|
(cons (cons key vfdEntries) vfdMap)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(setq i (1+ i))
|
|
)
|
|
|
|
;; ------------------------
|
|
;; 2) Build chainMap by prefix.
|
|
;; Only EXPORT if tpeCount > 0 (TPE-first geometry).
|
|
;; Each record:
|
|
;; (section key tpeCount tpeSorted firstTPE lastTPE epcPoints)
|
|
;; ------------------------
|
|
(setq chainMap '())
|
|
|
|
;; keys to consider: union of tpeMap and epcMap (so EPCs are available for bootstrap)
|
|
(setq allKeys '())
|
|
(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))
|
|
|
|
;; EPC points list (xy only)
|
|
(setq epcPoints '())
|
|
(if epcEntries
|
|
(foreach it epcEntries (setq epcPoints (cons (cadr it) epcPoints)))
|
|
)
|
|
|
|
;; TPE-sorted + endpoints
|
|
(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 each chain by section ascending
|
|
(foreach kv chainMap
|
|
(setq chainKey (car kv))
|
|
(setq chains (cdr kv))
|
|
(setq chains (vl-sort chains '(lambda (a b) (< (car a) (car b)))))
|
|
(setq chainMap (subst (cons chainKey chains) kv chainMap))
|
|
)
|
|
|
|
;; ------------------------
|
|
;; 3) Write CSV with:
|
|
;; - TPE-first geometry
|
|
;; - Stitch START from previous conveyor end for single-TPE
|
|
;; - EPC bootstrap START only if first in chain (no prevRec)
|
|
;; - vfd_count
|
|
;; ------------------------
|
|
(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,tpe_count,vfd_count,start_x,start_y,end_x,end_y" fh)
|
|
|
|
(foreach kv chainMap
|
|
(setq chainKey (car kv))
|
|
(setq chains (cdr kv)) ; sorted
|
|
|
|
(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))
|
|
|
|
;; Default: TPE-defined endpoints
|
|
(setq startXY firstTPE)
|
|
(setq endXY lastTPE)
|
|
|
|
;; Neighbor (previous section) record in same prefix chain
|
|
(setq prevRec (find-by-section chains (1- secNum)))
|
|
|
|
;; ----- If single-TPE, end is that TPE (already), start may stitch from prev end -----
|
|
(if (= tpeCount 1)
|
|
(progn
|
|
(setq endXY lastTPE) ; the only TPE
|
|
(if prevRec
|
|
(progn
|
|
(setq prevEnd (nth 5 prevRec)) ; prev lastTPE
|
|
(if (within? prevEnd endXY *MAX_STITCH_DISTANCE*)
|
|
(setq startXY prevEnd)
|
|
(setq startXY endXY)
|
|
)
|
|
)
|
|
(setq startXY endXY)
|
|
)
|
|
|
|
;; EPC bootstrap START only if NO prevRec (first conveyor 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)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; ----- If multi-TPE, allow EPC bootstrap only for FIRST conveyor in chain -----
|
|
(if (and (>= tpeCount 2) (not prevRec) epcPoints)
|
|
(progn
|
|
;; Only use EPC as START if it meaningfully extends beyond firstTPE->lastTPE
|
|
(setq endRef lastTPE)
|
|
(setq baseLen (dist2d firstTPE endRef))
|
|
|
|
(setq epcCandidate (farthest-from epcPoints endRef))
|
|
(if epcCandidate
|
|
(progn
|
|
(setq epcLen (dist2d epcCandidate endRef))
|
|
(if (and (> epcLen baseLen)
|
|
(within? epcCandidate endRef *MAX_BOOTSTRAP_DISTANCE*))
|
|
(setq startXY epcCandidate)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
;; vfd_count (unique VFD_v2 P_TAG1s)
|
|
(setq vfdCount 0)
|
|
(if (assoc key vfdMap)
|
|
(setq vfdCount (length (cdr (assoc key vfdMap))))
|
|
)
|
|
|
|
(write-line
|
|
(strcat
|
|
key ","
|
|
(itoa tpeCount) ","
|
|
(itoa vfdCount) ","
|
|
(rtos (car startXY) 2 6) "," (rtos (cadr startXY) 2 6) ","
|
|
(rtos (car endXY) 2 6) "," (rtos (cadr endXY) 2 6)
|
|
)
|
|
fh
|
|
)
|
|
)
|
|
)
|
|
|
|
(close fh)
|
|
(princ (strcat "\nExported conveyors to: " outPath))
|
|
(princ "\nGeometry: TPE-first. EPC used only as START bootstrap for first conveyor in chain when it extends the belt.")
|
|
(princ (strcat "\nStitch: single-TPE start may stitch from previous end (MAX_STITCH_DISTANCE=" (rtos *MAX_STITCH_DISTANCE* 2 2) ")."))
|
|
(princ (strcat "\nBootstrap: EPC->endTPE guarded by MAX_BOOTSTRAP_DISTANCE=" (rtos *MAX_BOOTSTRAP_DISTANCE* 2 2) "."))
|
|
(princ "\nAdded vfd_count from VFD_v2 (unique P_TAG1 values per conveyor_key).")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(princ)
|
|
)
|
|
|
|
(princ "\nLoaded. Run command: EXPORT_CONVEYORS")
|
|
(princ)
|