1287 lines
52 KiB
Common Lisp
1287 lines
52 KiB
Common Lisp
;;; automation-master-sequential.lsp
|
||
;;; Sequential CSV reading by TAGNAME, place blocks and populate attributes immediately.
|
||
|
||
(defun disable-snap-states ()
|
||
"Turn OFF Osnap, Ortho, and Object Snap Tracking"
|
||
|
||
;; Turn OFF Osnap using system variable
|
||
(setvar "OSMODE" 0)
|
||
(princ "\n<Osnap off>")
|
||
|
||
;; Turn OFF Ortho
|
||
(command "ORTHO" "OFF")
|
||
(princ "\n<Ortho off>")
|
||
|
||
;; Turn OFF Object Snap Tracking using system variable
|
||
(setvar "AUTOSNAP" (boole 6 (getvar "AUTOSNAP") 2)) ; Turn off tracking bit
|
||
(princ "\n<Object Snap Tracking off>")
|
||
|
||
(princ "\nSnap states disabled...")
|
||
)
|
||
|
||
(defun enable-snap-states ()
|
||
"Turn ON Osnap, Ortho, and Object Snap Tracking"
|
||
|
||
;; Turn ON Osnap using system variable (common snap modes)
|
||
(setvar "OSMODE" 4133) ; Common snap modes: endpoint, midpoint, center, intersection, etc.
|
||
(princ "\n<Osnap on>")
|
||
|
||
;; Turn ON Ortho
|
||
(command "ORTHO" "ON")
|
||
(princ "\n<Ortho on>")
|
||
|
||
;; Turn ON Object Snap Tracking using system variable
|
||
(setvar "AUTOSNAP" (boole 7 (getvar "AUTOSNAP") 2)) ; Turn on tracking bit
|
||
(princ "\n<Object Snap Tracking on>")
|
||
|
||
(princ "\nSnap states enabled...")
|
||
)
|
||
|
||
;; devlay_update section starts here
|
||
|
||
;; Function to get attribute value by tag from a list of attributes
|
||
(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)))
|
||
""
|
||
)
|
||
)
|
||
|
||
;; Function to get attribute object by tag from a list of attributes
|
||
(defun getAttObj (attList tag)
|
||
(setq tag (strcase tag))
|
||
(vl-some
|
||
(function
|
||
(lambda (a)
|
||
(if (= (strcase (vla-get-tagstring a)) tag)
|
||
a
|
||
)
|
||
)
|
||
)
|
||
attList
|
||
)
|
||
)
|
||
|
||
;; Function to move TAG1 attribute up and left by 0.5 units (without changing color)
|
||
(defun moveTag1UpLeft (block / att basePt newPt)
|
||
(foreach att (vlax-invoke block 'GetAttributes)
|
||
(if (= (strcase (vla-get-tagstring att)) "TAG1")
|
||
(progn
|
||
(setq basePt (vlax-get att 'InsertionPoint))
|
||
(setq newPt (list (+ (car basePt) 0.5) (+ (cadr basePt) 0.5) (caddr basePt)))
|
||
(vlax-put att 'InsertionPoint newPt)
|
||
(if (vlax-property-available-p att 'AlignmentPoint)
|
||
(vlax-put att 'AlignmentPoint newPt)
|
||
)
|
||
(if (vlax-property-available-p att 'TextAlignmentPoint)
|
||
(vlax-put att 'TextAlignmentPoint newPt)
|
||
)
|
||
;; Removed color change - TAG1 should stay at default color
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Function to set attribute value in a block
|
||
(defun setBlockAttr (block tag value)
|
||
(foreach att (vlax-invoke block 'GetAttributes)
|
||
(if (= (strcase (vla-get-tagstring att)) (strcase tag))
|
||
(vla-put-textstring att value)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Helper to trim PB/SPB suffixes from DESCA strings for cable DESC2 fields
|
||
(defun sanitizeCableDesc (value / cleaned suffixes suf lenTxt lenS startIdx)
|
||
(cond
|
||
((or (null value) (= value "")) "")
|
||
(T
|
||
(setq cleaned value)
|
||
(setq suffixes '("_PB_LT" "_SPB_LT" "_PB" "_SPB"))
|
||
(foreach suf suffixes
|
||
(setq lenTxt (strlen cleaned))
|
||
(setq lenS (strlen suf))
|
||
(if (>= lenTxt lenS)
|
||
(progn
|
||
(setq startIdx (- (+ lenTxt 1) lenS))
|
||
(if (= (strcase (substr cleaned startIdx lenS)) (strcase suf))
|
||
(setq cleaned (substr cleaned 1 (- startIdx 1)))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
;; remove trailing underscores left behind after trimming suffixes
|
||
(while (and (> (strlen cleaned) 0) (= (substr cleaned (strlen cleaned)) "_"))
|
||
(setq cleaned (substr cleaned 1 (1- (strlen cleaned)))))
|
||
|
||
;; For beacon devices, strip trailing element suffix after the BCN* part
|
||
;; Example: BYBA_17_BCN2_R -> BYBA_17_BCN2
|
||
(setq up (strcase cleaned))
|
||
(setq posBCN (vl-string-search "BCN" up))
|
||
(if posBCN
|
||
(progn
|
||
;; find underscore after BCN token (BCN + digits)
|
||
(setq idx (vl-string-search "_" up (+ posBCN 3)))
|
||
(if idx
|
||
(setq cleaned (substr cleaned 1 idx))
|
||
)
|
||
)
|
||
)
|
||
|
||
(strcase cleaned)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Helper to set DESC2 attribute on cordset blocks
|
||
(defun setCableDesc2 (block descaValue / cleaned)
|
||
(if (and block descaValue (/= descaValue ""))
|
||
(progn
|
||
(setq cleaned (sanitizeCableDesc descaValue))
|
||
(if (/= cleaned "")
|
||
(setBlockAttr block "DESC2" cleaned)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Function to build pairs of DESCA blocks
|
||
(defun build-pairs (maxNum)
|
||
(setq result '())
|
||
(setq n 1)
|
||
(while (<= n maxNum)
|
||
(setq a (strcat "DESCA" (if (< n 10) (strcat "0" (itoa n)) (itoa n))))
|
||
(setq next (+ n 1))
|
||
(if (<= next maxNum)
|
||
(setq b (strcat "DESCA" (if (< next 10) (strcat "0" (itoa next)) (itoa next))))
|
||
(setq b "")
|
||
)
|
||
(setq result (append result (list (list a b))))
|
||
(setq n (+ n 2))
|
||
)
|
||
result
|
||
)
|
||
|
||
;; Function to delete existing blocks
|
||
(defun delete-existing-devlay-blocks ( / blockNames ss i ent obj)
|
||
(setq blockNames '(
|
||
"HC01_CORDSET_STR-STR_STRAIGHT"
|
||
"HC01_SPLITTER"
|
||
"HC01_SPLITTER(RIGHT)"
|
||
))
|
||
|
||
(foreach blkName blockNames
|
||
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 blkName))))
|
||
(if ss
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq ent (ssname ss i))
|
||
(setq obj (vlax-ename->vla-object ent))
|
||
(vla-delete obj)
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
;; Delete all red circles (used as error indicators)
|
||
(setq ss (ssget "_X" '((0 . "CIRCLE") (62 . 1)))) ; 62=1 → red
|
||
(if ss
|
||
(progn
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq ent (ssname ss i))
|
||
(setq obj (vlax-ename->vla-object ent))
|
||
(vla-delete obj)
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Function to process each block type
|
||
(defun process-block-type (blkName maxDesca)
|
||
(setq filter (list (cons 0 "INSERT") (cons 2 blkName)))
|
||
(setq sioLikeBlocks '("PLCIO_ARMORBLOCK_SIO" "PLCIO_ARMORBLOCK_FIOM" "PLCIO_ARMORBLOCK_FIOH"))
|
||
(setq mirrorThreshold (if (member blkName sioLikeBlocks) 9 7))
|
||
(setq ss (ssget "X" filter))
|
||
|
||
;; Initialize pairs of attributes for DESCA blocks
|
||
(if ss
|
||
(progn
|
||
(princ (strcat "\n[devlay_update] Found blocks named \"" blkName "\"."))
|
||
(setq pairs (build-pairs maxDesca))
|
||
(setq i 0)
|
||
(while (< i (sslength ss))
|
||
(setq ent (ssname ss i))
|
||
(setq attList (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes))
|
||
|
||
(foreach pair pairs
|
||
(setq val1 (getAttVal attList (car pair)))
|
||
(setq val2 (getAttVal attList (cadr pair)))
|
||
|
||
;; Treat "SPARE" as empty
|
||
(if (= val1 "SPARE") (setq val1 ""))
|
||
(if (= val2 "SPARE") (setq val2 ""))
|
||
|
||
;; Case 1: both have values (pairs)
|
||
(if (and (/= val1 "") (/= val2 ""))
|
||
(progn
|
||
(setq att1 (getAttObj attList (car pair)))
|
||
(setq att2 (getAttObj attList (cadr pair)))
|
||
|
||
(if (and att1 att2)
|
||
(progn
|
||
(setq oldAttdia (getvar "ATTDIA"))
|
||
(setq oldAttreq (getvar "ATTREQ"))
|
||
(setvar "ATTDIA" 0)
|
||
(setvar "ATTREQ" 0)
|
||
|
||
(setq pt1 (vlax-get att1 'InsertionPoint))
|
||
(setq pt2 (vlax-get att2 'InsertionPoint))
|
||
|
||
(setq tagNum (atoi (substr (car pair) 6)))
|
||
|
||
;; Calculate cable position: Offset from port center to align cable connector with port
|
||
;; The cable block connector should align with pt1 (port center)
|
||
;; For left side: connector is at right end of cable, so insert cable offset left of port
|
||
;; For right side: connector is at left end of cable, so insert cable offset right of port
|
||
(cond
|
||
((= blkName "PLCIO_ARMORPOWERFLEX")
|
||
;; VFD: Calculate offset to center connector on port
|
||
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -1.7))
|
||
)
|
||
((or (= blkName "PLCIO_ARMORBLOCK_FIOM") (= blkName "PLCIO_ARMORBLOCK_FIOH"))
|
||
;; FIOM/FIOH: Use port center as reference, offset will be calculated below
|
||
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7))
|
||
)
|
||
(T
|
||
;; Other blocks (SIO, etc.)
|
||
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7))
|
||
)
|
||
)
|
||
|
||
;; Extra right shift for SIO tag 7
|
||
(setq shiftRightX
|
||
(if (and (= tagNum 7)
|
||
(not (= blkName "PLCIO_ARMORPOWERFLEX")))
|
||
2.0
|
||
0.0
|
||
)
|
||
)
|
||
|
||
(setq x1 (+ (car pt1) xOffset shiftRightX))
|
||
(setq xCordset (if (>= tagNum mirrorThreshold) (- x1 0.13) x1))
|
||
(setq y1 (+ (cadr pt1) 0.1))
|
||
(setq newPt1 (list xCordset y1 0.0))
|
||
|
||
;; NEW: Check if block is FIO or FIOH
|
||
(if (or (= blkName "PLCIO_ARMORBLOCK_FIOM") (= blkName "PLCIO_ARMORBLOCK_FIOH"))
|
||
(progn
|
||
;; separate handling for FIOM vs FIOH
|
||
(cond
|
||
;; --- FIOM block placement ---
|
||
((= blkName "PLCIO_ARMORBLOCK_FIOM")
|
||
(setq newPt1Adjusted
|
||
(if (>= tagNum mirrorThreshold)
|
||
;; Right side (FIOM)
|
||
(list (- (car newPt1) 2.4571) (+ (- (cadr newPt1) 0.6375) 0.25) (caddr newPt1))
|
||
;; Left side (FIOM)
|
||
(list (+ (car newPt1) 0.9) (+ (- (cadr newPt1) 0.6375) 0.1) (caddr newPt1))
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- FIOH block placement ---
|
||
((= blkName "PLCIO_ARMORBLOCK_FIOH")
|
||
(setq newPt1Adjusted
|
||
(if (>= tagNum mirrorThreshold)
|
||
;; Right side (FIOH)
|
||
(list (- (car newPt1) 1.4571) (- (cadr newPt1) 0.6375) (caddr newPt1))
|
||
;; Left side (FIOH)
|
||
(list (+ (car newPt1) 0.7) (- (cadr newPt1) 0.6375) (caddr newPt1))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; --- Additional shift for tag 7 and 8 (applies to both) ---
|
||
(if (or (= tagNum 7) (= tagNum 8))
|
||
(setq newPt1Adjusted
|
||
(list
|
||
(- (car newPt1Adjusted) 2.0)
|
||
(cadr newPt1Adjusted)
|
||
(caddr newPt1Adjusted)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; === Check patterns: single cable or splitter? ===
|
||
(if (and val1 val2
|
||
(or (and (vl-string-search "SEL" val1) (vl-string-search "SEL" val2))
|
||
(and (vl-string-search "DPM" val1) (vl-string-search "DPM" val2))
|
||
(and (vl-string-search "VFD" val1) (vl-string-search "STO" val1)
|
||
(vl-string-search "VFD" val2) (vl-string-search "STO" val2))
|
||
;; Pushbutton + pilot light pairs (e.g. *_PB and *_PB_LT)
|
||
(and (vl-string-search "_PB" val1) (vl-string-search "_PB_LT" val2))
|
||
(and (vl-string-search "_PB_LT" val1) (vl-string-search "_PB" val2))
|
||
;; Beacon stack elements (e.g. *_BCN1_A and *_BCN1_H) → single cable, no splitter
|
||
(and (vl-string-search "BCN" val1) (vl-string-search "BCN" val2))
|
||
(and (vl-string-search "EPC" val1) (vl-string-search "EPC" val2))
|
||
(and (vl-string-search "SSP" val1) (vl-string-search "SSP" val2))
|
||
;; PDP*_CB pairs → single cable, no splitter
|
||
(and (vl-string-search "PDP" val1) (vl-string-search "_CB" val1)
|
||
(vl-string-search "PDP" val2) (vl-string-search "_CB" val2))))
|
||
(progn
|
||
;; === SINGLE CABLE ===
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1Adjusted 1 1 0)
|
||
(setq newBlock1 (vlax-ename->vla-object (entlast)))
|
||
(setq tagnumStr (substr (car pair) 6))
|
||
(setq tagnum (atoi tagnumStr))
|
||
(setq taga1
|
||
(cond
|
||
;; --- FIOH: even number logic + trim last 2 chars ---
|
||
((= blkName "PLCIO_ARMORBLOCK_FIOH")
|
||
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
|
||
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
|
||
(setq val (getAttVal attList (strcat "TAGA" evenTagStr)))
|
||
(substr val 1 (- (strlen val) 2))
|
||
)
|
||
|
||
;; --- FIOM: simple value + trim last 2 chars (remove _0 etc.) ---
|
||
((= blkName "PLCIO_ARMORBLOCK_FIOM")
|
||
(setq val (getAttVal attList (strcat "TAGA" tagnumStr)))
|
||
(substr val 1 (- (strlen val) 2))
|
||
)
|
||
|
||
;; --- Default for other blocks ---
|
||
(T (getAttVal attList (strcat "TAGA" tagnumStr)))
|
||
)
|
||
)
|
||
(setBlockAttr newBlock1 "TAG1" taga1)
|
||
(setCableDesc2 newBlock1 val1)
|
||
)
|
||
(progn
|
||
;; === SPLITTER: two cables + splitter ===
|
||
(setq y2 (+ (cadr pt2) 0.1))
|
||
(setq newPt2 (list (car newPt1Adjusted) y2 0.0))
|
||
|
||
;; 1) First straight
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1Adjusted 1 1 0)
|
||
(setq newBlock1 (vlax-ename->vla-object (entlast)))
|
||
(setq taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
|
||
(setBlockAttr newBlock1 "TAG1" taga1)
|
||
(setCableDesc2 newBlock1 val1)
|
||
|
||
;; 2) Second straight
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
|
||
(setq newBlock2 (vlax-ename->vla-object (entlast)))
|
||
(setq taga2 (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
|
||
(setBlockAttr newBlock2 "TAG1" taga2)
|
||
(setCableDesc2 newBlock2 val2)
|
||
|
||
;; 3) Splitter between them
|
||
(setq x3 (+ (car newPt1Adjusted) (if (< tagNum mirrorThreshold) 1.25 -1.25)))
|
||
(setq y3 (/ (+ (cadr newPt1Adjusted) y2) 2.0))
|
||
(setq newPt3 (list x3 y3 0.0))
|
||
|
||
(if (< tagNum mirrorThreshold)
|
||
(progn
|
||
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
|
||
(setq splitterEnt (vlax-ename->vla-object (entlast)))
|
||
)
|
||
(progn
|
||
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
|
||
(setq splitterEnt (vlax-ename->vla-object (entlast)))
|
||
(setq newPos (list (- x3 2.2) (+ y3 0.0) 0.0))
|
||
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
|
||
)
|
||
)
|
||
|
||
;; === SHIFT WHOLE GROUP UP AND LEFT (after inserting two cords + splitter) ===
|
||
(setq moveX -0.5) ; left shift
|
||
(setq moveY 0.5) ; upward shift
|
||
|
||
(vla-move newBlock1 (vlax-3d-point newPt1Adjusted)
|
||
(vlax-3d-point (+ (car newPt1Adjusted) moveX)
|
||
(+ (cadr newPt1Adjusted) moveY)
|
||
(caddr newPt1Adjusted)))
|
||
|
||
(vla-move newBlock2 (vlax-3d-point newPt2)
|
||
(vlax-3d-point (+ (car newPt2) moveX)
|
||
(- (cadr newPt2) 0.1)
|
||
(caddr newPt2)))
|
||
|
||
;; Ensure splitterEnt exists for both sides
|
||
(if (not splitterEnt)
|
||
(setq splitterEnt (vlax-ename->vla-object (entlast)))
|
||
)
|
||
|
||
;; Move splitter
|
||
(if splitterEnt
|
||
(vla-move splitterEnt
|
||
(vlax-3d-point newPt3)
|
||
(vlax-3d-point (+ (car newPt3) moveX)
|
||
(+ (- (cadr newPt3) 0.3) moveY)
|
||
(caddr newPt3)))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(progn
|
||
;; EXISTING CODE for all other blocks
|
||
(if (and val1 val2
|
||
(or (and (vl-string-search "SEL" val1) (vl-string-search "SEL" val2))
|
||
(and (vl-string-search "DPM" val1) (vl-string-search "DPM" val2))
|
||
(and (vl-string-search "VFD" val1) (vl-string-search "STO" val1)
|
||
(vl-string-search "VFD" val2) (vl-string-search "STO" val2))
|
||
;; Pushbutton + pilot light pairs (e.g. *_PB and *_PB_LT)
|
||
(and (vl-string-search "_PB" val1) (vl-string-search "_PB_LT" val2))
|
||
(and (vl-string-search "_PB_LT" val1) (vl-string-search "_PB" val2))
|
||
;; Beacon stack elements (e.g. *_BCN1_A and *_BCN1_H) → single cable, no splitter
|
||
(and (vl-string-search "BCN" val1) (vl-string-search "BCN" val2))
|
||
(and (vl-string-search "EPC" val1) (vl-string-search "EPC" val2))
|
||
(and (vl-string-search "SSP" val1) (vl-string-search "SSP" val2))
|
||
;; PDP*_CB pairs → single cable, no splitter
|
||
(and (vl-string-search "PDP" val1) (vl-string-search "_CB" val1)
|
||
(vl-string-search "PDP" val2) (vl-string-search "_CB" val2))))
|
||
(progn
|
||
;; Insert single straight block
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
|
||
(setq newBlock (vlax-ename->vla-object (entlast)))
|
||
|
||
;; Set TAG1 attribute
|
||
(setq tagnumStr (substr (car pair) 6))
|
||
(setq taga (getAttVal attList (strcat "TAGA" tagnumStr)))
|
||
(setBlockAttr newBlock "TAG1" taga)
|
||
(setCableDesc2 newBlock val1)
|
||
|
||
;; Mirror if needed
|
||
(setq tagNum (atoi tagnumStr))
|
||
(setq finalBlock newBlock) ; assume no mirror
|
||
|
||
(if (>= tagNum mirrorThreshold)
|
||
(progn
|
||
(command "_MIRROR" (vlax-vla-object->ename newBlock) "" newPt1 (list (car newPt1) (+ (cadr newPt1) 0.1)) "N")
|
||
(entdel (vlax-vla-object->ename newBlock))
|
||
(setq finalBlock (vlax-ename->vla-object (entlast))) ; update to mirrored block
|
||
)
|
||
)
|
||
|
||
;; Move all SEL blocks 1 unit down. Also move 4 units left for DESCA07 - 09 (SIO)
|
||
(setq shiftX (if (>= tagNum mirrorThreshold) -3 0))
|
||
(setq shiftY -0.5)
|
||
|
||
;; Get current position of block (not assuming newPt1 anymore)
|
||
(setq basePt (vlax-get finalBlock 'InsertionPoint))
|
||
(setq targetPt (list (+ (car basePt) shiftX)
|
||
(+ (cadr basePt) shiftY)
|
||
(caddr basePt)))
|
||
|
||
(vla-move finalBlock
|
||
(vlax-3d-point basePt)
|
||
(vlax-3d-point targetPt))
|
||
)
|
||
(progn
|
||
;; ELSE part: Insert two straight blocks + splitter
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
|
||
(setq newBlock1 (vlax-ename->vla-object (entlast)))
|
||
(setq taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
|
||
(setCableDesc2 newBlock1 val1)
|
||
|
||
(setq y2 (+ (cadr pt2) 0.1))
|
||
(setq newPt2 (list xCordset y2 0.0))
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
|
||
(setq newBlock2 (vlax-ename->vla-object (entlast)))
|
||
(setq taga2 (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
|
||
(setBlockAttr newBlock1 "TAG1" taga1)
|
||
(setBlockAttr newBlock2 "TAG1" taga2)
|
||
(setCableDesc2 newBlock2 val2)
|
||
|
||
(setq x3 (+ x1 (if (< tagNum mirrorThreshold) 1.25 -1.25)))
|
||
(setq y3 (/ (+ y1 y2) 2.0))
|
||
(setq newPt3 (list x3 y3 0.0))
|
||
|
||
(if (< tagNum mirrorThreshold)
|
||
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
|
||
(progn
|
||
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
|
||
(setq splitterEnt (vlax-ename->vla-object (entlast)))
|
||
(setq newPos (list (- x3 2.2) (+ y3 0.0) 0.0))
|
||
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
|
||
)
|
||
)
|
||
|
||
;; VFD splitter positioning: use same rules as VFD single cables
|
||
(if (= blkName "PLCIO_ARMORPOWERFLEX")
|
||
(progn
|
||
(setq shiftY -0.5) ; same vertical shift as single cables
|
||
|
||
(setq basePt1 (vlax-get newBlock1 'InsertionPoint))
|
||
(setq basePt2 (vlax-get newBlock2 'InsertionPoint))
|
||
(setq basePt3 (vlax-get (vlax-ename->vla-object (entlast)) 'InsertionPoint))
|
||
|
||
(vla-move newBlock1 (vlax-3d-point basePt1)
|
||
(vlax-3d-point (car basePt1) (+ (cadr basePt1) shiftY) (caddr basePt1)))
|
||
(vla-move newBlock2 (vlax-3d-point basePt2)
|
||
(vlax-3d-point (car basePt2) (+ (cadr basePt2) shiftY) (caddr basePt2)))
|
||
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point basePt3)
|
||
(vlax-3d-point (car basePt3) (+ (cadr basePt3) shiftY) (caddr basePt3)))
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
(setvar "ATTDIA" oldAttdia)
|
||
(setvar "ATTREQ" oldAttreq)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; Case 2: single value only
|
||
(if (and (/= val1 "") (= val2 ""))
|
||
(progn
|
||
(setq attTag (if (/= val1 "") (car pair) (cadr pair)))
|
||
(setq attObj (getAttObj attList attTag))
|
||
|
||
(if attObj
|
||
(progn
|
||
(setq oldAttdia (getvar "ATTDIA"))
|
||
(setq oldAttreq (getvar "ATTREQ"))
|
||
(setvar "ATTDIA" 0)
|
||
(setvar "ATTREQ" 0)
|
||
|
||
(setq pt (vlax-get attObj 'InsertionPoint))
|
||
(setq tagNum (atoi (substr attTag 6)))
|
||
(setq xOffset (if (< tagNum mirrorThreshold) 5.5 -5.0))
|
||
(setq x (+ (car pt) xOffset))
|
||
(setq y (- (cadr pt) 0.5))
|
||
(setq xAdjust
|
||
(if (and (member blkName sioLikeBlocks) (>= tagNum 9))
|
||
0.0 ; right side → move slightly left
|
||
(if (member blkName sioLikeBlocks)
|
||
0.7 ; left side → move slightly right
|
||
0.0 ; other blocks → no change
|
||
)
|
||
)
|
||
)
|
||
;; Extra right shift for Powerflex DESCA07+
|
||
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
|
||
(setq xAdjust (+ xAdjust 1.0))
|
||
)
|
||
|
||
(setq insPt (list (+ x xAdjust) y 0.0))
|
||
|
||
;; For PLCIO_ARMORPOWERFLEX, special DESCA11 block placement
|
||
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
|
||
(setq insPt (list (+ x 2.0) (+ y 0.5) 0.0))
|
||
)
|
||
|
||
;; Insert cable block
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0)
|
||
|
||
(setq newEnt (entlast))
|
||
(setq newBlock (vlax-ename->vla-object newEnt))
|
||
|
||
;; FIX: Keep string version for TAGA, convert to int for comparisons
|
||
(setq tagnumStr (substr attTag 6))
|
||
(setq tagnum (atoi tagnumStr))
|
||
(setq taga
|
||
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
|
||
(progn
|
||
;; Make sure tag number is always odd
|
||
(setq oddNum (if (/= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
|
||
(setq oddTagStr (if (< oddNum 10) (strcat "0" (itoa oddNum)) (itoa oddNum)))
|
||
(getAttVal attList (strcat "TAGA" oddTagStr))
|
||
)
|
||
(getAttVal attList (strcat "TAGA" tagnumStr))
|
||
)
|
||
)
|
||
(setBlockAttr newBlock "TAG1" taga)
|
||
(setCableDesc2 newBlock val1)
|
||
|
||
; Mirror blocks for DESCA07 and above except special single DESCA11
|
||
(if (and (>= tagnum mirrorThreshold)
|
||
(not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagnum 11))))
|
||
(progn
|
||
(command "_MIRROR" newEnt "" insPt (list (car insPt) (+ (cadr insPt) 0.1)) "N")
|
||
(entdel newEnt)
|
||
(setq newBlock (vlax-ename->vla-object (entlast)))
|
||
)
|
||
)
|
||
|
||
;; Move single straight block left/right depending on side
|
||
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagnum 7))
|
||
(and (member blkName sioLikeBlocks)
|
||
(not (= blkName "PLCIO_ARMORBLOCK_FIOM"))
|
||
(>= tagnum 8)
|
||
(= tagnum 15)))
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (+ (car basePt) 0.5) (cadr basePt) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
;; Move SIO-like single blocks on left side to the left
|
||
(if (and (member blkName sioLikeBlocks) (< tagnum 8))
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (- (car basePt) 0.7) (cadr basePt) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
;; Final vertical adjustment for FIOM single blocks
|
||
(if (= blkName "PLCIO_ARMORBLOCK_FIOM")
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (car basePt) (+ (cadr basePt) 0.2) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
(setvar "ATTDIA" oldAttdia)
|
||
(setvar "ATTREQ" oldAttreq)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;; ELSE branch: val1 is empty, val2 has value → create cable for val2
|
||
(if (and (= val1 "") (/= val2 ""))
|
||
(progn
|
||
(setq attTag (cadr pair)) ; Use second attribute since that's where the value is
|
||
(setq attObj (getAttObj attList attTag))
|
||
|
||
(if attObj
|
||
(progn
|
||
(setq oldAttdia (getvar "ATTDIA"))
|
||
(setq oldAttreq (getvar "ATTREQ"))
|
||
(setvar "ATTDIA" 0)
|
||
(setvar "ATTREQ" 0)
|
||
|
||
(setq pt (vlax-get attObj 'InsertionPoint))
|
||
(setq tagNum (atoi (substr attTag 6)))
|
||
(setq xOffset (if (< tagNum mirrorThreshold) 5.5 -5.0))
|
||
(setq x (+ (car pt) xOffset))
|
||
(setq y (- (cadr pt) 0.5))
|
||
(setq xAdjust
|
||
(if (and (member blkName sioLikeBlocks) (>= tagNum 9))
|
||
0.0
|
||
(if (member blkName sioLikeBlocks)
|
||
0.7
|
||
0.0
|
||
)
|
||
)
|
||
)
|
||
;; Extra right shift for Powerflex DESCA07+
|
||
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
|
||
(setq xAdjust (+ xAdjust 1.0))
|
||
)
|
||
|
||
(setq insPt (list (+ x xAdjust) y 0.0))
|
||
|
||
;; For PLCIO_ARMORPOWERFLEX, special DESCA11 block placement
|
||
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
|
||
(setq insPt (list (+ x 2.0) (+ y 0.5) 0.0))
|
||
)
|
||
|
||
;; Insert cable block
|
||
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0)
|
||
|
||
(setq newEnt (entlast))
|
||
(setq newBlock (vlax-ename->vla-object newEnt))
|
||
|
||
(setq tagnumStr (substr attTag 6))
|
||
(setq tagnum (atoi tagnumStr))
|
||
(setq taga
|
||
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
|
||
(progn
|
||
(setq oddNum (if (/= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
|
||
(setq oddTagStr (if (< oddNum 10) (strcat "0" (itoa oddNum)) (itoa oddNum)))
|
||
(getAttVal attList (strcat "TAGA" oddTagStr))
|
||
)
|
||
(getAttVal attList (strcat "TAGA" tagnumStr))
|
||
)
|
||
)
|
||
(setBlockAttr newBlock "TAG1" taga)
|
||
(setCableDesc2 newBlock val2)
|
||
|
||
; Mirror blocks for DESCA07 and above except special single DESCA11
|
||
(if (and (>= tagnum mirrorThreshold)
|
||
(not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagnum 11))))
|
||
(progn
|
||
(command "_MIRROR" newEnt "" insPt (list (car insPt) (+ (cadr insPt) 0.1)) "N")
|
||
(entdel newEnt)
|
||
(setq newBlock (vlax-ename->vla-object (entlast)))
|
||
)
|
||
)
|
||
|
||
;; Move single straight block left/right depending on side
|
||
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagnum 7))
|
||
(and (member blkName sioLikeBlocks)
|
||
(not (= blkName "PLCIO_ARMORBLOCK_FIOM"))
|
||
(>= tagnum 8)
|
||
(= tagnum 15)))
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (+ (car basePt) 0.5) (cadr basePt) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
;; Move SIO-like single blocks on left side to the left
|
||
(if (and (member blkName sioLikeBlocks) (< tagnum 8))
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (- (car basePt) 0.7) (cadr basePt) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
;; Final vertical adjustment for FIOM single blocks
|
||
(if (= blkName "PLCIO_ARMORBLOCK_FIOM")
|
||
(progn
|
||
(setq basePt (vlax-get newBlock 'InsertionPoint))
|
||
(setq targetPt (list (car basePt) (+ (cadr basePt) 0.2) (caddr basePt)))
|
||
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
|
||
(setvar "ATTDIA" oldAttdia)
|
||
(setvar "ATTREQ" oldAttreq)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
(setq i (1+ i))
|
||
)
|
||
)
|
||
(princ (strcat "\n[devlay_update] No blocks named \"" blkName "\" found."))
|
||
)
|
||
)
|
||
|
||
(defun devlay_update ()
|
||
(delete-existing-devlay-blocks)
|
||
(process-block-type "PLCIO_ARMORPOWERFLEX" 11)
|
||
(process-block-type "PLCIO_ARMORBLOCK_SIO" 16)
|
||
(process-block-type "PLCIO_ARMORBLOCK_FIOM" 16)
|
||
(process-block-type "PLCIO_ARMORBLOCK_FIOH" 16)
|
||
(princ)
|
||
)
|
||
|
||
;; devlay_update section ends here
|
||
|
||
|
||
;;; -----------------------
|
||
;;; Utilities
|
||
;;; -----------------------
|
||
(defun trim (s) (vl-string-trim " \t\n\r" s) )
|
||
|
||
(defun csv-first-field (line / pos)
|
||
(if (null line) ""
|
||
(progn
|
||
(setq pos (vl-string-search "," line))
|
||
(if pos (trim (substr line 1 pos)) (trim line))
|
||
)
|
||
)
|
||
)
|
||
|
||
(defun split-csv-line (line / start pos cols len cell)
|
||
(setq cols '())
|
||
(setq start 0)
|
||
(setq len (strlen line))
|
||
(while (and (< start len) (setq pos (vl-string-search "," line start)))
|
||
(setq cell (trim (substr line (+ start 1) (- pos start))))
|
||
;; remove surrounding double quotes if present
|
||
(if (and (> (strlen cell) 1)
|
||
(= (substr cell 1 1) "\"")
|
||
(= (substr cell (strlen cell) 1) "\""))
|
||
(setq cell (substr cell 2 (- (strlen cell) 2))))
|
||
(setq cols (append cols (list cell)))
|
||
;; move start to the character after the comma (pos is 0-based index of comma)
|
||
(setq start (+ pos 1))
|
||
)
|
||
;; handle last column: if start == len then last column is empty string
|
||
(if (<= start len)
|
||
(progn
|
||
(if (< start len)
|
||
(setq cell (trim (substr line (+ start 1) (- len start))))
|
||
(setq cell "") ; trailing comma -> empty last column
|
||
)
|
||
;; remove surrounding quotes on last cell too
|
||
(if (and (> (strlen cell) 1)
|
||
(= (substr cell 1 1) "\"")
|
||
(= (substr cell (strlen cell) 1) "\""))
|
||
(setq cell (substr cell 2 (- (strlen cell) 2))))
|
||
(setq cols (append cols (list cell)))
|
||
)
|
||
)
|
||
cols
|
||
)
|
||
|
||
|
||
(defun my-subseq (lst start end / result i len)
|
||
(setq result '())
|
||
(setq len (length lst))
|
||
(setq end (min end len))
|
||
(setq i start)
|
||
(while (< i end)
|
||
(setq result (append result (list (nth i lst))))
|
||
(setq i (1+ i))
|
||
)
|
||
result
|
||
)
|
||
|
||
;;; -----------------------
|
||
;;; Block helpers
|
||
;;; -----------------------
|
||
(defun insertBlockAt (blockName basePt targetPt)
|
||
(command "_.-INSERT" blockName basePt 1 1 0)
|
||
(setq ent (entlast))
|
||
(if ent
|
||
(progn
|
||
(vla-move (vlax-ename->vla-object ent)
|
||
(vlax-3d-point basePt)
|
||
(vlax-3d-point targetPt))
|
||
)
|
||
)
|
||
ent
|
||
)
|
||
|
||
(defun setDESCAtoSpare (block)
|
||
(foreach att (vlax-invoke block 'GetAttributes)
|
||
(setq tag (strcase (vla-get-tagstring att)))
|
||
(if (wcmatch tag "DESCA*") (vla-put-textstring att "SPARE"))
|
||
)
|
||
)
|
||
|
||
;;; -----------------------
|
||
;;; Attribute population (dynamic rows)
|
||
;;; csvData: list of rows belonging to this block (each row = list of columns)
|
||
;;; columns: 0=TAGNAME,1=ADDR,2=TERM,3=TERMDESC,4=DESCA,5=DESCB
|
||
;;; -----------------------
|
||
(defun populateBlockAttributes (block csvData / att tag1Attr attr attrName row i rowIndex numRows fmtIdx fldVal targetTag firstTag)
|
||
(setq att (vlax-invoke block 'GetAttributes))
|
||
(if (not att)
|
||
(progn (princ "\nWarning: block has no attributes.") )
|
||
(progn
|
||
;; TAG1 or TAG1F using first row's TAGNAME
|
||
(setq firstTag (if (and csvData (> (length csvData) 0)) (nth 0 (nth 0 csvData)) ""))
|
||
(setq tag1Attr (vl-some
|
||
(function (lambda (a)
|
||
(setq attrName (strcase (vla-get-tagstring a)))
|
||
(if (equal attrName "TAG1") a nil)))
|
||
att))
|
||
(if tag1Attr
|
||
(vla-put-textstring tag1Attr (strcase firstTag))
|
||
(progn
|
||
(setq tag1Attr (vl-some
|
||
(function (lambda (a)
|
||
(setq attrName (strcase (vla-get-tagstring a)))
|
||
(if (equal attrName "TAG1F") a nil)))
|
||
att))
|
||
(if tag1Attr (vla-put-textstring tag1Attr (strcase firstTag)))
|
||
)
|
||
)
|
||
|
||
;; dynamic number of rows for indexing
|
||
(setq numRows (length csvData))
|
||
(setq i 0)
|
||
(while (< i numRows)
|
||
(setq row (nth i csvData))
|
||
(setq rowIndex (1+ i))
|
||
;; format index as 01,02...09,10...
|
||
(setq fmtIdx (if (< rowIndex 10) (strcat "0" (itoa rowIndex)) (itoa rowIndex)))
|
||
|
||
;; ADDR -> TAGA##
|
||
(setq targetTag (strcat "TAGA" fmtIdx))
|
||
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
|
||
(setq fldVal (if (and row (>= (length row) 2)) (nth 1 row) ""))
|
||
(if attr (vla-put-textstring attr fldVal))
|
||
|
||
;; TERM -> TERM##
|
||
(setq targetTag (strcat "TERM" fmtIdx))
|
||
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
|
||
(setq fldVal (if (and row (>= (length row) 3)) (nth 2 row) ""))
|
||
(if attr (vla-put-textstring attr fldVal))
|
||
|
||
;; DESCA -> DESCA##
|
||
(setq targetTag (strcat "DESCA" fmtIdx))
|
||
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
|
||
(setq fldVal (if (and row (>= (length row) 5)) (nth 4 row) ""))
|
||
(if attr (vla-put-textstring attr fldVal))
|
||
|
||
;; DESCB -> DESCB##
|
||
(setq targetTag (strcat "DESCB" fmtIdx))
|
||
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
|
||
(setq fldVal (if (and row (>= (length row) 6)) (nth 5 row) ""))
|
||
(if attr (vla-put-textstring attr fldVal))
|
||
|
||
(setq i (1+ i))
|
||
)
|
||
;; update block to refresh attributes
|
||
(vlax-invoke (vlax-ename->vla-object (entlast)) 'Update)
|
||
)
|
||
)
|
||
)
|
||
|
||
|
||
;;; -----------------------
|
||
;;; Device placement — sequential TAGNAME grouping approach
|
||
;;; layoutDevices not precomputed: we use csvRows + csvIndex and group rows by TAGNAME
|
||
;;; -----------------------
|
||
(defun placeSequentialDevices (layoutStartX posIndex deviceTag blockRows / blk ent vlaEnt pos)
|
||
;; deviceTag = group TAGNAME (string)
|
||
;; blockRows = list of rows belonging to this block
|
||
|
||
;; choose block type by searching TAGNAME (case-insensitive)
|
||
(setq devUpper (strcase deviceTag))
|
||
(setq blk
|
||
(cond
|
||
((vl-string-search "VFD" devUpper) "PLCIO_ARMORPOWERFLEX")
|
||
((vl-string-search "APF" devUpper) "PLCIO_ARMORPOWERFLEX")
|
||
((vl-string-search "SIO" devUpper) "PLCIO_ARMORBLOCK_SIO")
|
||
((vl-string-search "FIOH" devUpper) "PLCIO_ARMORBLOCK_FIOH")
|
||
((vl-string-search "FIO" devUpper) "PLCIO_ARMORBLOCK_FIOM")
|
||
(T nil)
|
||
)
|
||
)
|
||
|
||
;; --- Base position templates ---
|
||
(setq positions (list
|
||
(list 9.63 9.5 0.0)
|
||
(list 9.63 -1.5 0.0)
|
||
(list 28.88 9.5 0.0)
|
||
(list 28.88 -1.5 0.0)))
|
||
|
||
;; FIOH positions (Hub – old spacing)
|
||
(setq positionsFIOH (list
|
||
(list 9.6 9.5 0.0)
|
||
(list 9.6 -1.5 0.0)
|
||
(list 28.9666 9.5 0.0)
|
||
(list 28.9666 -1.5 0.0)))
|
||
|
||
;; FIO positions (new, slightly taller/wider)
|
||
(setq positionsFIO (list
|
||
(list 9.6 9.85 0.0)
|
||
(list 9.6 -1.15 0.0)
|
||
(list 28.9666 9.85 0.0)
|
||
(list 28.9666 -1.15 0.0)))
|
||
|
||
;; --- Determine which set of positions to use ---
|
||
(cond
|
||
((vl-string-search "FIOH" devUpper)
|
||
(setq pos (mapcar '+ (nth posIndex positionsFIOH) (list layoutStartX 0 0))))
|
||
((vl-string-search "FIO" devUpper)
|
||
(setq pos (mapcar '+ (nth posIndex positionsFIO) (list layoutStartX 0 0))))
|
||
(T
|
||
(setq pos (mapcar '+ (nth posIndex positions) (list layoutStartX 0 0))))
|
||
)
|
||
|
||
;; --- Insert and populate ---
|
||
(if blk
|
||
(progn
|
||
(insertBlockAt blk '(0 0 0) pos)
|
||
|
||
;; --- FIOM-specific 20_zone adjustment (left & right) ---
|
||
(if (and blk (vl-string-search "FIOM" (strcase deviceTag)))
|
||
(progn
|
||
(cond
|
||
((member posIndex '(0 1)) ; left side
|
||
(adjust20ZoneForFIOM *curr-left-zone* posIndex)
|
||
(setq *fiom-left-pos* posIndex))
|
||
((member posIndex '(2 3)) ; right side
|
||
(adjust20ZoneForFIOM *curr-right-zone* posIndex)
|
||
(setq *fiom-right-pos* posIndex))
|
||
)
|
||
)
|
||
)
|
||
|
||
(setq ent (entlast))
|
||
(if ent
|
||
(progn
|
||
(setq vlaEnt (vlax-ename->vla-object ent))
|
||
(setDESCAtoSpare vlaEnt)
|
||
(populateBlockAttributes vlaEnt blockRows)
|
||
)
|
||
(princ (strcat "\nFailed to insert block: " blk))
|
||
)
|
||
)
|
||
(princ (strcat "\nWarning: could not determine block type for: " deviceTag))
|
||
)
|
||
)
|
||
|
||
;;; -----------------------
|
||
;;; 20_zone helpers
|
||
;;; -----------------------
|
||
|
||
(defun fmt2 (n)
|
||
(if (< n 10)
|
||
(strcat "0" (itoa n))
|
||
(itoa n))
|
||
)
|
||
|
||
(defun to-int (x)
|
||
(if (numberp x) x (atoi x))
|
||
)
|
||
|
||
(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue suffixBase sideOffset
|
||
/ blockObj attrList sortedList attrPair idx intBase intPart suffixPart newText)
|
||
"Update LINE## attributes with values like 2600.01 ... 2600.40.
|
||
Fixes unordered attribute iteration by sorting numerically first."
|
||
(setq blockObj (vlax-ename->vla-object blockEnt))
|
||
(setq attrList (vlax-invoke blockObj 'GetAttributes))
|
||
|
||
;; integer part (constant for all lines in block)
|
||
(setq intBase (to-int startValue))
|
||
(setq intPart (+ intBase (to-int layoutIndex) (to-int sideOffset)))
|
||
|
||
;; sort attributes by numeric LINE## suffix
|
||
(setq sortedList
|
||
(vl-sort
|
||
(mapcar
|
||
'(lambda (a)
|
||
(list (atoi (substr (vla-get-tagstring a) 5)) a))
|
||
attrList)
|
||
'(lambda (x y) (< (car x) (car y))))
|
||
)
|
||
|
||
;; now loop in correct order
|
||
(setq idx 0)
|
||
(foreach attrPair sortedList
|
||
(setq idx (1+ idx))
|
||
(setq attr (cadr attrPair))
|
||
(setq suffixPart (fmt2 (+ suffixBase (1- idx))))
|
||
(setq newText (strcat (itoa intPart) "." suffixPart))
|
||
(vla-put-textstring attr newText)
|
||
(vlax-invoke attr 'Update)
|
||
)
|
||
|
||
(vlax-invoke blockObj 'Update)
|
||
)
|
||
|
||
;;; -----------------------
|
||
;;; FIOM-specific adjustments for 20_zone
|
||
;;; -----------------------
|
||
;; vertical Y-offsets for 8 lines in FIOM layouts
|
||
(setq *FIOM-YOFFSETS*
|
||
'(
|
||
(1 . 0.26)
|
||
(2 . 0.78)
|
||
(3 . 1.16)
|
||
(4 . 1.64)
|
||
(5 . 1.89)
|
||
(6 . 2.40)
|
||
(7 . 2.79)
|
||
(8 . 3.28)
|
||
)
|
||
)
|
||
|
||
(defun fiom-yoffset (relIndex / hit)
|
||
(setq hit (assoc relIndex *FIOM-YOFFSETS*))
|
||
(if hit (cdr hit) 0.0)
|
||
)
|
||
|
||
(defun adjust20ZoneForFIOM (zoneEnt posIndex / blockObj attList idx relIdx lineIndices a pt yoff newPt)
|
||
"Shift the correct 8 attributes of 20_zone block when FIOM exists (top/bottom, left/right),
|
||
and set justification to Middle Left for those lines only."
|
||
(if (null zoneEnt)
|
||
(princ "\n[FIOM] zone block not found.")
|
||
(progn
|
||
;; which 8 attributes to move based on FIOM position
|
||
(setq lineIndices
|
||
(cond
|
||
((= posIndex 0) '(1 2 3 4 5 6 7 8)) ; top-left
|
||
((= posIndex 1) '(12 13 14 15 16 17 18 19)) ; bottom-left
|
||
((= posIndex 2) '(1 2 3 4 5 6 7 8)) ; top-right
|
||
((= posIndex 3) '(12 13 14 15 16 17 18 19)) ; bottom-right
|
||
(T nil)
|
||
)
|
||
)
|
||
|
||
(if lineIndices
|
||
(progn
|
||
(setq blockObj (vlax-ename->vla-object zoneEnt))
|
||
(setq attList (vlax-invoke blockObj 'GetAttributes))
|
||
(setq idx 1)
|
||
(foreach a attList
|
||
(if (member idx lineIndices)
|
||
(progn
|
||
(setq relIdx (1+ (vl-position idx lineIndices))) ; 1..8
|
||
(setq pt (vlax-get a 'InsertionPoint))
|
||
(setq yoff (fiom-yoffset relIdx))
|
||
|
||
;; set justification to Middle Left (9) BEFORE changing position
|
||
(if (vlax-property-available-p a 'Alignment)
|
||
(vlax-put a 'Alignment 9)) ; 9 = acAlignmentMiddleLeft
|
||
|
||
;; move only vertically
|
||
(setq newPt (list (car pt) (+ (cadr pt) yoff) (caddr pt)))
|
||
|
||
;; For Middle Left, use TextAlignmentPoint
|
||
(if (vlax-property-available-p a 'TextAlignmentPoint)
|
||
(vlax-put a 'TextAlignmentPoint newPt))
|
||
|
||
;; update attribute
|
||
(vlax-invoke a 'Update)
|
||
)
|
||
)
|
||
(setq idx (1+ idx))
|
||
)
|
||
(vlax-invoke blockObj 'Update)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
)
|
||
|
||
;;; -----------------------
|
||
;;; MAIN FUNCTION
|
||
;;; -----------------------
|
||
(setq *curr-left-zone* nil)
|
||
(setq *curr-right-zone* nil)
|
||
(setq *fiom-left-pos* nil) ; stores posIndex when FIOM placed on left
|
||
(setq *fiom-right-pos* nil) ; stores posIndex when FIOM placed on right
|
||
|
||
(defun c:init_layout ( / csvFile csvRows file line cols headerSkipped csvIndex totalRows layoutNum layoutStartX posIndex blocksLeft numBlocksInLayout layoutDevices firstTag currentTag blockRows)
|
||
(disable-snap-states)
|
||
|
||
;; select CSV
|
||
(setq csvFile (getfiled "Select source CSV file" "" "csv" 0))
|
||
(if (not csvFile) (progn (princ "\nNo CSV file selected. Aborting.") (princ))
|
||
(progn
|
||
;; read CSV lines into list, skipping header (first non-empty line)
|
||
(setq csvRows '())
|
||
(setq file (open csvFile "r"))
|
||
(setq headerSkipped nil)
|
||
(while (setq line (read-line file))
|
||
(if (not (= line ""))
|
||
(progn
|
||
(if headerSkipped
|
||
(progn
|
||
(setq cols (split-csv-line line))
|
||
(setq csvRows (append csvRows (list cols)))
|
||
)
|
||
(setq headerSkipped T) ; first non-empty row considered header and skipped
|
||
)
|
||
)
|
||
)
|
||
)
|
||
(close file)
|
||
|
||
;; prepare drawing
|
||
(setq oldAttReq (getvar "ATTREQ")) (setvar "ATTREQ" 0)
|
||
(setq offsetX 38.5)
|
||
|
||
;; user start index (keeps old behavior for 20_zone)
|
||
(setq startIndex (getstring "\nEnter starting line index (e.g. 01600): "))
|
||
|
||
;; sequential processing
|
||
(setq csvIndex 0)
|
||
(setq totalRows (length csvRows))
|
||
(setq layoutNum 0)
|
||
(setq posIndex 0) ; position within current layout (0..3)
|
||
|
||
(while (< csvIndex totalRows)
|
||
;; if starting a new layout (posIndex == 0) draw the layout box and 20_zone blocks
|
||
(if (= posIndex 0)
|
||
(progn
|
||
(setq layoutStartX (* layoutNum offsetX))
|
||
;; Reset FIOM tracking for new layout
|
||
(setq *fiom-left-pos* nil)
|
||
(setq *fiom-right-pos* nil)
|
||
|
||
;; draw outer box and lines (same as before)
|
||
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0))
|
||
(command (list (+ 38.5 layoutStartX) -11.0))
|
||
(command (list (+ 38.5 layoutStartX) 11.0))
|
||
(command (list (+ 0 layoutStartX) 11.0))
|
||
(command "C")
|
||
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0) (list (+ 0 layoutStartX) 11.0) "")
|
||
(command "_.PLINE" (list (+ 38.5 layoutStartX) -11.0) (list (+ 38.5 layoutStartX) 11.0) "")
|
||
(command "_.PLINE" (list (+ 19.25 layoutStartX) -11.0) (list (+ 19.25 layoutStartX) 11.0) "")
|
||
|
||
;; Insert 20_zone left & right and label them
|
||
(setq basePt '(0 0 0))
|
||
(setq ptLeft (list (+ 0.75 layoutStartX) 9.5 0))
|
||
(setq ptRight (list (+ 20.0 layoutStartX) 9.5 0))
|
||
|
||
(setq leftEnt (insertBlockAt "20_zone" basePt ptLeft))
|
||
(setq *curr-left-zone* leftEnt)
|
||
(setq *curr-right-zone* nil) ; initialize right zone tracker
|
||
(if leftEnt
|
||
(progn
|
||
(setq leftBlock (vlax-ename->vla-object leftEnt))
|
||
(update20ZoneBlockAttributes leftEnt layoutNum startIndex 1 0)
|
||
; (labelBlockLines leftBlock 1 nil) ; ADD nil parameter
|
||
)
|
||
)
|
||
(setq rightEnt (insertBlockAt "20_zone" basePt ptRight))
|
||
(setq *curr-right-zone* rightEnt) ; store right zone
|
||
(if rightEnt
|
||
(progn
|
||
(setq rightBlock (vlax-ename->vla-object rightEnt))
|
||
(update20ZoneBlockAttributes rightEnt layoutNum startIndex 21 0)
|
||
; (labelBlockLines rightBlock 21 nil) ; ADD nil parameter
|
||
)
|
||
)
|
||
;; layout label
|
||
(setq labelPt (list (+ layoutStartX 14.0) 16.0 0.0))
|
||
(command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ layoutNum))))
|
||
)
|
||
) ; end layout start
|
||
|
||
;; read current row TAGNAME
|
||
(setq firstTag (nth 0 (nth csvIndex csvRows)))
|
||
(setq currentTag firstTag)
|
||
(setq blockRows (list (nth csvIndex csvRows)))
|
||
(setq csvIndex (1+ csvIndex))
|
||
|
||
;; collect following rows with same TAGNAME
|
||
(while (and (< csvIndex totalRows)
|
||
(equal (nth 0 (nth csvIndex csvRows)) currentTag))
|
||
(setq blockRows (append blockRows (list (nth csvIndex csvRows))))
|
||
(setq csvIndex (1+ csvIndex))
|
||
)
|
||
|
||
;; now we have blockRows (one or more rows) for currentTag
|
||
;; place block at current layoutStartX and posIndex
|
||
(placeSequentialDevices layoutStartX posIndex currentTag blockRows)
|
||
|
||
;; advance posIndex; if it reaches 4 start new layout
|
||
(setq posIndex (1+ posIndex))
|
||
(if (>= posIndex 4)
|
||
(progn (setq posIndex 0) (setq layoutNum (1+ layoutNum)))
|
||
)
|
||
) ; end while csvIndex < totalRows
|
||
|
||
;; cleanup
|
||
(setvar "ATTREQ" oldAttReq)
|
||
(command "_.color" "BYLAYER")
|
||
(princ (strcat "\nDone. Processed " (itoa layoutNum) " full layouts (plus partial last layout if any)."))
|
||
(princ)
|
||
)
|
||
)
|
||
(devlay_update)
|
||
(enable-snap-states)
|
||
(princ)
|
||
)
|