;;; automation-master-sequential.lsp ;;; Sequential CSV reading by TAGNAME, place blocks and populate attributes immediately. ;;; devlay_update section starts here (defun disable-snap-states () "Turn OFF Osnap, Ortho, and Object Snap Tracking" ;; Turn OFF Osnap using system variable (setvar "OSMODE" 0) (princ "\n") ;; Turn OFF Ortho (command "ORTHO" "OFF") (princ "\n") ;; Turn OFF Object Snap Tracking using system variable (setvar "AUTOSNAP" (boole 6 (getvar "AUTOSNAP") 2)) ; Turn off tracking bit (princ "\n") (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") ;; Turn ON Ortho (command "ORTHO" "ON") (princ "\n") ;; Turn ON Object Snap Tracking using system variable (setvar "AUTOSNAP" (boole 7 (getvar "AUTOSNAP") 2)) ; Turn on tracking bit (princ "\n") (princ "\nSnap states enabled...") ) ;; 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 (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) ) (vlax-put att 'Color 2) ) ) ) ) ;; 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) ) ) ) ;; 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" "CORDSET_STR-STR_1DEVICE PER PORT" "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_ARMBLOCK_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))) (setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7)) (setq shiftRightX (if (= tagNum 7) 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_ARMBLOCK_FIOM") (= blkName "PLCIO_ARMORBLOCK_FIOH")) (progn (setq newPt1Adjusted (if (>= tagNum mirrorThreshold) ;; Right side (list (- (car newPt1) 1.4571) (- (cadr newPt1) 0.6375) (caddr newPt1)) ;; Left side (list (+ (car newPt1) 0.7) (- (cadr newPt1) 0.6375) (caddr newPt1)) ) ) ;; Additional shift if TAG7 or TAG8 (if (or (= tagNum 7) (= tagNum 8)) (setq newPt1Adjusted (list (- (car newPt1Adjusted) 2.0) (cadr newPt1Adjusted) (caddr newPt1Adjusted) ) ) ) (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 (if (= blkName "PLCIO_ARMORBLOCK_FIOH") (progn (setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1))) (setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum))) ;; Remove last two chars from TAGA value (setq val (getAttVal attList (strcat "TAGA" evenTagStr))) (substr val 1 (- (strlen val) 2)) ) (getAttVal attList (strcat "TAGA" tagnumStr)) ) ) (setBlockAttr newBlock1 "TAG1" taga1) ) (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)) ;; NEW: Additional conditions for single straight block (and (vl-string-search "VFD" val1) (vl-string-search "STO" val1) (vl-string-search "VFD" val2) (vl-string-search "STO" val2)) (and (vl-string-search "JR" val1) (vl-string-search "_PB" val1) (vl-string-search "JR" val2) (vl-string-search "_PB_LT" val2)) (and (vl-string-search "EPC" val1) (vl-string-search "EPC" val2)) (and (vl-string-search "SSP" val1) (vl-string-search "SSP" 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) ;; 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 ) ) ;; === NEW: Move single straight block left/right depending on side === (if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7)) (and (member blkName sioLikeBlocks) (>= tagNum 8))) ;; Right side: move left 1 unit (progn (setq basePt (vlax-get finalBlock 'InsertionPoint)) (setq targetPt (list (- (car basePt) 0.5) (cadr basePt) (caddr basePt))) (vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt)) ) ;; Left side: move right 0.5 unit (if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (<= tagNum 7)) (and (member blkName sioLikeBlocks) (< tagNum 8))) (progn (setq basePt (vlax-get finalBlock 'InsertionPoint)) (setq targetPt (list (+ (car basePt) 1.0) (cadr basePt) (caddr basePt))) (vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt)) ) ) ) ;; === END NEW === ;; 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)))) (setBlockAttr newBlock1 "TAG1" taga1) (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 newBlock2 "TAG1" taga2) (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)) ) ) ;; Extra adjustment for Powerflex DESCA07+ (move all 3 blocks left, splitter up) (if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7)) (progn (setq newX1 (- (car newPt1) 1.8)) (setq newX2 (- (car newPt2) 1.8)) (setq newX3 (- (car newPt3) 1.8)) (setq newY3 (+ (cadr newPt3) 0.0)) ; splitter up (vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 (cadr newPt1) (caddr newPt1))) (vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 (cadr newPt2) (caddr newPt2))) (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3))) ) ) ;; If this is the second block type, shift blocks closer together (if (member blkName sioLikeBlocks) (progn (setq moveVecX (if (or (= tagNum 7) (= tagNum 8)) -1.5 (if (< tagNum mirrorThreshold) 0.5 -1.4) ) ) ; inward move ;; Additional right shift of 0.5 for SIO-like blocks on right side (tagNum >= 9) (setq rightShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.5 0.0)) ;; Additional downward shift of 0.5 for SIO-like blocks on right side (tagNum >= 9) (setq downShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.1 0.0)) (setq newX1 (+ (car newPt1) moveVecX rightShift)) (setq newX2 (+ (car newPt2) moveVecX rightShift)) (setq newX3 (if (or (= tagNum 7) (= tagNum 8)) (+ (car newPt3) -1.5 rightShift) (+ (car newPt3) moveVecX rightShift) ) ) (setq newY1 (- (cadr newPt1) downShift)) (setq newY2 (- (cadr newPt2) downShift)) (setq newY3 (if (or (= tagNum 7) (= tagNum 8)) (+ (cadr newPt3) -0.015 downShift) (- (cadr newPt3) downShift) ) ) (vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 newY1 (caddr newPt1))) (vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 newY2 (caddr newPt2))) (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3))) ) ) ) ) ) ) (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 proper block based on conditions (if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11)) (command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0) ; old block special single (command "_-INSERT" "CORDSET_STR-STR_1DEVICE PER PORT" insPt 1 1 0) ; other singles ) (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 (setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1))) (setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum))) (getAttVal attList (strcat "TAGA" evenTagStr)) ) (getAttVal attList (strcat "TAGA" tagnumStr)) ) ) (setBlockAttr newBlock "TAG1" taga) ;; For non-special single blocks, move attribute (if (not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))) (moveTag1UpLeft newBlock) ) ; Mirror blocks for DESCA07 and above except special single DESCA11 ; FIX: Use tagnum (integer) instead of comparing with string (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))) ) ) ;; === NEW: Move single straight block left/right depending on side === (if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagnum 7)) (and (member blkName sioLikeBlocks) (>= tagnum 8) (= tagnum 15))) ;; Right side: move left 1 unit (only for last DESCA in SIO-like blocks) (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)) ) ) ;; === NEW: Move SIO-like single blocks on left side to the left === (if (and (member blkName sioLikeBlocks) (< tagnum 8)) ;; Left side SIO-like blocks: move left 0.5 unit (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)) ) ) ;; === END NEW === (setvar "ATTDIA" oldAttdia) (setvar "ATTREQ" oldAttreq) ) ) ) ) ;; ELSE branch: val1 is empty, val2 has value → print warning (if (and (= val1 "") (/= val2 "")) (progn (setq attTag (car pair)) ; Always expect the first attribute to be filled (setq attObj (getAttObj attList attTag)) (if attObj (progn ;; Insertion point of the attribute itself (setq insPt (vlax-get attObj 'InsertionPoint)) ;; Draw red circle to mark the issue (entmakex (list (cons 0 "CIRCLE") (cons 8 "0") ; Layer (cons 10 insPt) ; Center at attribute (cons 40 1.3) ; Radius (cons 62 1) ; Red color ) ) ) ) ) ) ) (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_ARMBLOCK_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_ARMBLOCK_FIOM") (T nil) ) ) ;; positions arrays (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))) (setq positionsB (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))) (if blk (progn ;; compute insertion pos using posIndex and layoutStartX (setq pos (if (or (vl-string-search "FIOH" devUpper) (vl-string-search "FIO" devUpper)) (mapcar '+ (nth posIndex positionsB) (list layoutStartX 0 0)) (mapcar '+ (nth posIndex positions) (list layoutStartX 0 0)))) ;; insert and fill (insertBlockAt blk '(0 0 0) pos) (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 (unchanged logic) ;;; ----------------------- (defun labelBlockLines (block startNum) (setq counter 0) (foreach att (vlax-invoke block 'GetAttributes) (setq tag (strcase (vla-get-tagstring att))) (if (wcmatch tag "LINE*") (progn (setq labelNum (+ startNum counter)) (setq labelStr (if (< labelNum 10) (strcat "0" (itoa labelNum)) (itoa labelNum))) (setq basePt (vlax-get att 'InsertionPoint)) (setq blockPos (vlax-get block 'InsertionPoint)) (setq labelPt (list (+ (car blockPos) 0.12) (- (cadr basePt) 0.053) (caddr basePt))) (entmakex (list (cons 0 "TEXT") (cons 8 "0") (cons 7 "WD") (cons 62 7) (cons 10 labelPt) (cons 11 labelPt) (cons 40 0.13) (cons 72 1) (cons 73 1) (cons 1 labelStr) (cons 50 0.0))) (setq counter (1+ counter)) ) ) ) ) (defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue sideOffset / blockObj attrList attr attrName idx newValue formattedValue) (setq blockObj (vlax-ename->vla-object blockEnt)) (setq attrList (vlax-invoke blockObj 'GetAttributes)) (foreach attr attrList (setq attrName (vlax-get-property attr 'TagString)) (if (and (>= (strlen attrName) 5) (= (substr attrName 1 4) "LINE") (>= (atoi (substr attrName 5)) 1) (<= (atoi (substr attrName 5)) 20)) (progn (setq idx (atoi (substr attrName 5))) (setq newValue (+ (atoi startValue) layoutIndex (- idx 1) sideOffset)) (setq formattedValue (strcat (itoa newValue) ".")) (vlax-put-property attr 'TextString formattedValue) (vlax-invoke attr 'Update) ) ) ) (vlax-invoke blockObj 'Update) ) ;;; ----------------------- ;;; MAIN FUNCTION ;;; ----------------------- (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)) ;; 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)) (if leftEnt (progn (setq leftBlock (vlax-ename->vla-object leftEnt)) (update20ZoneBlockAttributes leftEnt layoutNum startIndex 0) (labelBlockLines leftBlock 1) ) ) (setq rightEnt (insertBlockAt "20_zone" basePt ptRight)) (if rightEnt (progn (setq rightBlock (vlax-ename->vla-object rightEnt)) (update20ZoneBlockAttributes rightEnt layoutNum startIndex 0) (labelBlockLines rightBlock 21) ) ) ;; 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) )