From c042a34879e2f0915f15f4fe6362ef92c1b008e8 Mon Sep 17 00:00:00 2001 From: Salijoghli <107577102+Salijoghli@users.noreply.github.com> Date: Mon, 6 Oct 2025 11:34:28 +0400 Subject: [PATCH] modifications in some codes. feat: made new lsp that will take the data from the sorter file and do all the stuff in the autocad --- BNA8/automation-master.lsp | 934 +++++++++++++++++++++ BNA8/devlay-v2.lsp | 557 ++++++++++++ layout-base.lsp => BNA8/layout-base-v2.lsp | 210 +++-- BNA8/network-diagram-v3.lsp | 370 ++++++++ BNA8/network-v2.lsp | 256 ++++++ devlay.lsp | 391 --------- network-diagram-v2.lsp | 37 +- network-diagram-v3.lsp | 3 - read-csv.lsp | 175 ---- 9 files changed, 2295 insertions(+), 638 deletions(-) create mode 100644 BNA8/automation-master.lsp create mode 100644 BNA8/devlay-v2.lsp rename layout-base.lsp => BNA8/layout-base-v2.lsp (62%) create mode 100644 BNA8/network-diagram-v3.lsp create mode 100644 BNA8/network-v2.lsp delete mode 100644 devlay.lsp delete mode 100644 read-csv.lsp diff --git a/BNA8/automation-master.lsp b/BNA8/automation-master.lsp new file mode 100644 index 0000000..8eef113 --- /dev/null +++ b/BNA8/automation-master.lsp @@ -0,0 +1,934 @@ +;;; 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 "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) +) diff --git a/BNA8/devlay-v2.lsp b/BNA8/devlay-v2.lsp new file mode 100644 index 0000000..ff271e2 --- /dev/null +++ b/BNA8/devlay-v2.lsp @@ -0,0 +1,557 @@ +(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 c:devlay_update () + (disable-snap-states) + (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) + (enable-snap-states) + ) \ No newline at end of file diff --git a/layout-base.lsp b/BNA8/layout-base-v2.lsp similarity index 62% rename from layout-base.lsp rename to BNA8/layout-base-v2.lsp index 4275415..bd97c5c 100644 --- a/layout-base.lsp +++ b/BNA8/layout-base-v2.lsp @@ -9,59 +9,6 @@ ) ) -(defun insertBlockAt (blockName basePt targetPt) - (command "_.-INSERT" blockName basePt 1 1 0) - (setq ent (entlast)) - (vla-move (vlax-ename->vla-object ent) - (vlax-3d-point basePt) - (vlax-3d-point targetPt)) - ent -) - -(defun labelBlockLines (block startNum) - (foreach att (vlax-invoke block 'GetAttributes) - (setq tag (strcase (vla-get-tagstring att))) - (if (wcmatch tag "LINE*") - (progn - (setq idx (atoi (substr tag 5))) - (setq labelNum (+ startNum (- idx 1))) - (setq labelStr (if (< labelNum 10) - (strcat "0" (itoa labelNum)) - (itoa labelNum))) - (setq basePt (vlax-get att 'InsertionPoint)) - (setq labelPt (list (+ (car basePt) 0.55) (- (cadr basePt) 0.05) (caddr basePt))) - (entmake - (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) - (cons 100 "AcDbEntity") - (cons 100 "AcDbText") - (cons 100 "AcDbText") - ) - ) - ) - ) - ) -) - -(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") - ) - ) -) - (defun placeDeviceLabel (vlaBlock / insPt labelText labelPt ent) (setq insPt (vlax-get vlaBlock 'InsertionPoint)) (setq labelPt (list (+ (car insPt) 3.6) (+ (cadr insPt) 1.2) (caddr insPt))) @@ -70,6 +17,8 @@ (cond ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*POWERFLEX*") "APF") ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*SIO*") "SIO") + ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*FIOM*") "FIO") + ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*FIOH*") "FIOH") (T "") ) ) @@ -96,6 +45,65 @@ ) ) +(defun insertBlockAt (blockName basePt targetPt) + (command "_.-INSERT" blockName basePt 1 1 0) + (setq ent (entlast)) + (vla-move (vlax-ename->vla-object ent) + (vlax-3d-point basePt) + (vlax-3d-point targetPt)) + ent +) + +(defun labelBlockLines (block startNum) + (setq counter 0) ; Add a counter to track which attribute we're processing + (foreach att (vlax-invoke block 'GetAttributes) + (setq tag (strcase (vla-get-tagstring att))) + (if (wcmatch tag "LINE*") + (progn + ; Use counter instead of extracting from tag + (setq labelNum (+ startNum counter)) + (setq labelStr (if (< labelNum 10) + (strcat "0" (itoa labelNum)) + (itoa labelNum))) + ;; Use the block's X position + 0.12, and Y from the attribute - 0.053 + (setq basePt (vlax-get att 'InsertionPoint)) + (setq blockPos (vlax-get block 'InsertionPoint)) ; block base point + + ;; X from block + 0.12, Y from attribute - 0.053 + (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) + (cons 100 "AcDbEntity") + (cons 100 "AcDbText") + (cons 100 "AcDbText") + ) + ) + (setq counter (1+ counter)) ; Increment counter after processing each LINE attribute + ) + ) + ) +) + +(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") + ) + ) +) + ;; Function to read device list from a text file (defun readDeviceListFromFile ( / file filePath line result) ;; Open file dialog for user to pick device list text file @@ -125,31 +133,66 @@ ) ;; Function to read device list from file and return as a list -(defun placeDevicesInLayout (layoutStartX devices / basePt positions i blk pos ent) +(defun placeDevicesInLayout (layoutStartX devices / basePt positions i device blk pos ent vlaEnt) (setq basePt "0,0,0") - + ;; TODO: these cordinates are for the new SIO BLOCK coming from the amazon + ;; They are not used in the current layout, but can be used for future reference. + ; (setq positions (list + ; (list 3.57 5.06 0.0) ;; A + ; (list 3.57 -5.95 0.0) ;; B + ; (list 22.84 5.06 0.0) ;; C + ; (list 22.84 -5.95 0.0) ;; D + ; )) + + ;; Ordered list of positions: always A, B, C, D (setq positions (list - (list (+ layoutStartX 9.63) 9.5 0.0) ;; A - (list (+ layoutStartX 9.63) -1.5 0.0) ;; B - (list (+ layoutStartX 28.88) 9.5 0.0) ;; C - (list (+ layoutStartX 28.88) -1.5 0.0) ;; D + (list 9.63 9.5 0.0) ;; A + (list 9.63 -1.5 0.0) ;; B + (list 28.88 9.5 0.0) ;; C + (list 28.88 -1.5 0.0) ;; D + )) + + ;; Alternate layout for FIO/FIOH + (setq positionsB (list + (list 9.6 9.5 0.0) ;; A + (list 9.6 -1.5 0.0) ;; B + (list 28.9666 9.5 0.0) ;; C + (list 28.9666 -1.5 0.0) ;; D )) (setq i 0) + (while (< i (length devices)) (setq device (nth i devices)) (setq blk (cond ((vl-string-search "APF" device) "PLCIO_ARMORPOWERFLEX") ((vl-string-search "SIO" device) "PLCIO_ARMORBLOCK_SIO") + ((vl-string-search "FIOH" device) "PLCIO_ARMORBLOCK_FIOH") + ((vl-string-search "FIO" device) "PLCIO_ARMBLOCK_FIOM") (T nil) ) ) (if blk (progn - (setq pos (nth i positions)) + ;; Pick the correct layout based on device type and position index + (if (< i (length positions)) ; avoid overflow + (setq pos + (cond + ((or (vl-string-search "FIOH" device) (vl-string-search "FIO" device)) + (mapcar '+ (nth i positionsB) (list layoutStartX 0 0)) + ) + (T + (mapcar '+ (nth i positions) (list layoutStartX 0 0)) + ) + ) + ) + (setq pos (list layoutStartX 0 0)) ; fallback if too many devices + ) + + ;; Insert and move (command "_.-INSERT" blk basePt 1 1 0) (setq ent (entlast)) (if ent @@ -157,7 +200,7 @@ (setq vlaEnt (vlax-ename->vla-object ent)) (vla-move vlaEnt (vlax-3d-point 0 0 0) (vlax-3d-point pos)) (setDESCAtoSpare vlaEnt) - (placeDeviceLabel vlaEnt) + ; (placeDeviceLabel vlaEnt) ) (princ (strcat "\nFailed to insert block: " blk)) ) @@ -169,10 +212,46 @@ ) +(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 + ;; Convert string to number; compute base as start + layoutIndex + ;; then add per-line index (0-19) and side offset (0 for left, 20 for right) + (setq idx (atoi (substr attrName 5))) + (setq newValue (+ (atoi startValue) + layoutIndex + (- idx 1) + sideOffset)) + + ;; Format as string with period, no leading zeros + (setq formattedValue (strcat (itoa newValue) ".")) + + ;; Apply value + (vlax-put-property attr 'TextString formattedValue) + (vlax-invoke attr 'Update) + ) + ) + ) + + (vlax-invoke blockObj 'Update) +) + + + (defun c:init_layout_base ( / layoutData groupedData layoutCount offsetX i currentOffset basePt ptLeft ptRight leftEnt rightEnt leftBlock rightBlock labelPt) ;; Read layout from file - (setq layoutData (readDeviceListFromFile)) ; from previous step + (setq layoutData (readDeviceListFromFile)) ; (setq groupedData (chunk-list layoutData 4)) (setq layoutCount (length groupedData)) @@ -182,6 +261,9 @@ (setvar "ATTREQ" 0) (setq offsetX 38.5) + ;; prompt user for starting indexes + (setq startIndex (getstring "\nEnter starting line index (e.g. 01600): ")) + ;; Layout loop (setq i 0) (while (< i layoutCount) @@ -204,12 +286,16 @@ (setq ptLeft (list (+ 0.75 currentOffset) 9.5 0)) (setq ptRight (list (+ 20.0 currentOffset) 9.5 0)) + ;;todo fix the naming + (setq leftEnt (insertBlockAt "20_zone" basePt ptLeft)) (setq leftBlock (vlax-ename->vla-object leftEnt)) + (update20ZoneBlockAttributes leftEnt i startIndex 0) (labelBlockLines leftBlock 1) (setq rightEnt (insertBlockAt "20_zone" basePt ptRight)) (setq rightBlock (vlax-ename->vla-object rightEnt)) + (update20ZoneBlockAttributes rightEnt i startIndex 0) (labelBlockLines rightBlock 21) ;; Add layout label diff --git a/BNA8/network-diagram-v3.lsp b/BNA8/network-diagram-v3.lsp new file mode 100644 index 0000000..18e1dde --- /dev/null +++ b/BNA8/network-diagram-v3.lsp @@ -0,0 +1,370 @@ +no (defun clearDrawing ( / ss) + (setq ss (ssget "_X" '((0 . "*")))) + (if ss (command "_.erase" ss "")) + (princ "\nDrawing cleared.") +) + +(defun getVisibilityFromName (deviceName) + (cond + ((wcmatch (strcase deviceName) "*APF*") "APF") + ((wcmatch (strcase deviceName) "*VFD*") "VFD") + ((wcmatch (strcase deviceName) "*SIO*") "SIO") + ((wcmatch (strcase deviceName) "*FIO*") "FIO") + ((wcmatch (strcase deviceName) "*EX*") "EX") + ((wcmatch (strcase deviceName) "*SPARE*") "") + (T "DEFAULT") ;; fallback + ) +) + +(defun str-trim (s) + (vl-string-trim " \t\n\r" s) +) + +(defun setDeviceAttributes (blk ip device port / tag2 tag3 isVFD spacePos slashPos baseName part2 tag ip1 ip2 spacePosIP) + ;; Default values + (setq tag2 device) + (setq tag3 "") + (setq ip1 ip) + (setq ip2 "") + + ;; === VFD logic for tag2 and tag3 === + (if (and device (vl-string-search "VFD" (strcase device))) + (progn + (setq spacePos (vl-string-search " " device)) + (if spacePos + (progn + (setq part1 (substr device 1 spacePos)) + (setq part2 (substr device (+ spacePos 2))) + (setq slashPos (vl-string-search "/VFD" part1)) + (if slashPos + (setq baseName (substr part1 1 slashPos)) + (setq baseName part1) + ) + (setq tag2 (str-trim part1)) + (setq tag3 (strcat (str-trim baseName) "/" (str-trim part2))) + ) + ) + ) + ) + + ;; === IP splitting logic for ip1 and ip2 === + (setq spacePosIP (vl-string-search " " ip)) + (if spacePosIP + (progn + (setq ip1 (str-trim (substr ip 1 spacePosIP))) + (setq ip2 (str-trim (substr ip (+ spacePosIP 2)))) + ) + ;; else no space, ip2 stays "" + ) + + ;; Set attributes + (foreach att (vlax-invoke blk 'GetAttributes) + (setq tag (strcase (vla-get-tagstring att))) + (cond + ((= tag "IP") (vla-put-textstring att ip1)) + ((= tag "IP2") (vla-put-textstring att ip2)) + ((= tag "TAG2") (vla-put-textstring att tag2)) + ((= tag "PORT") (vla-put-textstring att port)) + ((= tag "TAG3") (if (> (strlen tag3) 0) (vla-put-textstring att tag3))) + ) + ) +) + + +(defun place-enet-devices (originX originY deviceGroup / blockName width count i x y basePt lastEnt targetPt blk visibilityValue deviceName device ip fullBlockName port) + (setq blockName "HDV2_ENET_DEVICE_") + (setq width 1.2) + (setq count (length deviceGroup)) + (setq i 0) + (setq y 20.4718) + + (while (< i count) + (setq count (length deviceGroup)) + (setq blockSpacing 1.2) + (setq groupWidth (* blockSpacing (1- count))) + (setq centerX 21.2) + (setq startX (- centerX (/ groupWidth 2.0))) + (setq x (+ startX (* i blockSpacing) 0.3)) + (setq basePt '(0 0 0)) + (setq targetPt (list (+ originX x) (+ originY y) 0)) + + (setq devicePair (nth i deviceGroup)) + (setq device (cdr (assoc "NAME" devicePair))) + (setq ip (cdr (assoc "IP" devicePair))) + (setq port (cdr (assoc "PORT" devicePair))) + ;; Create block name based on device visibility + (setq deviceName (getVisibilityFromName device)) + + (setq fullBlockName (strcat blockName deviceName)) + + (command "_.-INSERT" fullBlockName basePt 0.8 0.8 0.8 0) + ;; Process the inserted block + (if (setq lastEnt (entlast)) + (progn + ;; Convert to VLA object + (setq blk (vlax-ename->vla-object lastEnt)) + + ;; Move the block to target point + (vla-move blk + (vlax-3d-point basePt) + (vlax-3d-point targetPt) + ) + (vla-put-rotation blk 0.0) + (setDeviceAttributes blk ip device port) + + ) + (princ "\nFailed to get last entity.") + ) + + (setq i (1+ i)) + ) +) + +(defun labelZone32Lines (ent / vlaBlock att basePt labelPt labelStr height index rotation) + (if (and ent (eq (cdr (assoc 0 (entget ent))) "INSERT")) + (progn + (setq vlaBlock (vlax-ename->vla-object ent)) + (setq index 1) + + (foreach att (vlax-invoke vlaBlock 'GetAttributes) + (if (wcmatch (strcase (vla-get-tagstring att)) "LINE*") + (progn + (setq labelStr (if (< index 10) (strcat "0" (itoa index)) (itoa index))) + (setq basePt (vlax-get att 'InsertionPoint)) + (setq height (vla-get-height att)) + (setq rotation (vla-get-rotation att)) + + (setq labelPt + (list (- (car basePt) 0.05) ; left + (+ (cadr basePt) 0.65) ; up + (caddr basePt))) + + ;; Create label text + (entmake + (list + (cons 0 "TEXT") + (cons 8 "0") + (cons 7 "WD") + (cons 62 7) + (cons 10 labelPt) + (cons 11 labelPt) + (cons 40 height) + (cons 72 1) + (cons 73 2) + (cons 1 labelStr) + (cons 50 rotation) + (cons 100 "AcDbEntity") + (cons 100 "AcDbText") + ) + ) + (setq index (1+ index)) + ) + ) + ) + ) + (princ "\nInvalid entity passed to labelZone32Lines.") + ) + (princ) +) + +(defun parseCSVLine (line / pos result) + (setq result '()) + (while (setq pos (vl-string-search "," line)) + (setq result (append result (list (substr line 1 pos)))) + (setq line (substr line (+ pos 2))) + ) + (append result (list line)) +) + +(defun getDPMDataFromCSV ( / file filename line headers row dpm ip name deviceIP port dpmList deviceGroups currentGroup) + (setq filename (getfiled "Select CSV File" (strcat (getenv "USERPROFILE") "\\Desktop\\") "csv" 0)) + (if (not filename) + (progn (princ "\nNo file selected.") (exit)) + ) + (setq file (open filename "r")) + (if (not file) + (progn (princ "\nFailed to open file.") (exit)) + ) + + ;; Read header line + (read-line file) + (setq dpmList '()) + (setq deviceGroups '()) + (setq currentGroup '()) + + (while (setq line (read-line file)) + (setq row (parseCSVLine line)) + + (setq dpm (nth 0 row)) ; DPM name (can be empty) + (setq ip (nth 1 row)) + (setq name (nth 2 row)) + (setq deviceIP (nth 4 row)) + (setq port (nth 6 row)) + + ;; If a new DPM is found + (if (and dpm (/= dpm "")) + (progn + ;; If current group is not empty, pad and save it + (if (> (length currentGroup) 0) + (progn + (while (< (length currentGroup) 24) + (setq currentGroup + (append currentGroup + (list (list + (cons "NAME" "SPARE") + (cons "IP" "") + (cons "PORT" "") + )) + ) + ) + ) + (setq deviceGroups (append deviceGroups (list currentGroup))) + (setq currentGroup '()) + ) + ) + + ;; Register new DPM + (if (not (assoc dpm dpmList)) + (setq dpmList (append dpmList (list (cons dpm ip)))) + ) + ) + ) + + ;; Add valid device (skip blank names) + (if (and name (/= name "")) + (setq currentGroup + (append currentGroup + (list (list + (cons "NAME" name) + (cons "IP" deviceIP) + (cons "PORT" port) + )) + ) + ) + ) + + ;; If group reaches 24 devices — finalize + (if (= (length currentGroup) 24) + (progn + (setq deviceGroups (append deviceGroups (list currentGroup))) + (setq currentGroup '()) + ) + ) + ) + + ;; Handle final group if file ends before 24 + (if (> (length currentGroup) 0) + (progn + (while (< (length currentGroup) 24) + (setq currentGroup + (append currentGroup + (list (list + (cons "NAME" "SPARE") + (cons "IP" "") + (cons "PORT" "") + )) + ) + ) + ) + (setq deviceGroups (append deviceGroups (list currentGroup))) + ) + ) + + (close file) + (list dpmList deviceGroups) +) + +(defun c:init-diagrams ( / blockName count offsetX i x y) + (clearDrawing) + (setq blockName "layout") + (setq csvData (getDPMDataFromCSV)) + (setq dpmList (car csvData)) + (setq deviceGroups (cadr csvData)) + (setq count (length dpmList)) + (setq userInput (getstring "\nEnter zone number (e.g., 01, 02): ")) + + (if (and blockName (> count 0)) + (progn + (setq offsetX 43.5) + (setq i 0) + (while (< i count) + (setq x (* i offsetX)) + (setq y 0) + (setq basePt '(0 0 0)) + (setq targetPt (list x y 0)) + + ;; Insert layout + (command "_.-INSERT" blockName basePt 1 1 0) + (setq lastEnt (entlast)) + (if lastEnt + (vla-move + (vlax-ename->vla-object lastEnt) + (vlax-3d-point basePt) + (vlax-3d-point targetPt) + ) + ) + + ;; Insert DPM-UPS at fixed offset inside layout + (setq dpmPair (nth i dpmList)) + (setq dpmName (car dpmPair)) + (setq dpmIP (cdr dpmPair)) + (setq deviceGroup (nth i deviceGroups)) + + (setq dpmUpsPt (list (+ x 16.1) (+ y 2.1173) 0)) + (command "_.-INSERT" "DPM-UPS" dpmUpsPt 1 1 0) + + ;; Set IPADDRESS attribute if found + (setq lastEnt (entlast)) + (if lastEnt + (progn + (setq dpmUpsObj (vlax-ename->vla-object lastEnt)) + (foreach att (vlax-invoke dpmUpsObj 'GetAttributes) + (setq tag (strcase (vla-get-tagstring att))) + (cond + ((= tag "IPADDRESS") + (vla-put-textstring att dpmIP) + ) + ((= tag "TAG2") + (vla-put-textstring att dpmName) + ) + ) + ) + ) + ) + + ;; Calculate insertion point + (setq desiredX (+ x 0.7658)) + (setq desiredY (+ y 25.6873)) + + ;; Insert ZONE_32H at origin + (command "_.-INSERT" "ZONE_32H" '(0 0 0) 1 1 0) + + ;; Get the last inserted entity + (setq ent (entlast)) + + ;; Move the inserted block from (0,0,0) to desired point + (if ent + (progn + (setq vlaObj (vlax-ename->vla-object ent)) + (vla-move vlaObj (vlax-3d-point 0 0 0) (vlax-3d-point desiredX desiredY 0)) + ;; Set ALL attributes in the ZONE_32H block to E8912., E8913., etc. + (setq zoneName (strcat userInput (itoa (+ 702 i)) ".")) + (foreach att (vlax-invoke vlaObj 'GetAttributes) + (vla-put-textstring att zoneName) + ) + ;; Label the ZONE_32H lines + (labelZone32Lines ent) + ) + ) + + ;; Insert ENETs + (place-enet-devices x y deviceGroup) + + (setq i (1+ i)) + ) + (princ (strcat "\nInserted " (itoa count) " layouts side-by-side.")) + ) + (princ "\nInvalid input.") + ) + (princ) +) diff --git a/BNA8/network-v2.lsp b/BNA8/network-v2.lsp new file mode 100644 index 0000000..dfcae56 --- /dev/null +++ b/BNA8/network-v2.lsp @@ -0,0 +1,256 @@ +(defun readDeviceListFromFile ( / file filePath line result) + ;; Open file dialog for user to pick device list text file + (setq filePath (getfiled "Select Device List File" "" "txt" 0)) + (if filePath + (progn + (setq file (open filePath "r")) + (setq result '()) ;; initialize empty list before appending + (while (setq line (read-line file)) + (setq result (append result (list (strcase (vl-string-trim " \t\r\n" line))))) + ) + (close file) + result + ) + nil + ) +) + +(defun updateTagAttribute (ent tagValue / obj attribs att) + ;; Convert entity to VLA object + (setq obj (vlax-ename->vla-object ent)) + (if (and obj (eq (vla-get-hasattributes obj) :vlax-true)) + (progn + (setq attribs (vlax-invoke obj 'GetAttributes)) + (foreach att attribs + (if (eq (strcase (vla-get-TagString att)) "TAG1") + (vla-put-TextString att tagValue) + ) + ) + ) + ) +) + +(defun c:Init_Network ( / dpmCount rowCount colCount i row col x y spacingX spacingY blkName scaleFactor + startPt endPt zigzagStart secondCableEnds zigzagStarts ) + + (setq blkName "DPM") ; Block name + (setq hdvBlkName "HDV2_1756-EN4TR_CHILD") ; HDV block name + (setq scaleFactor 0.45) ; Scale of each block + (setq spacingX 15.0) ; Horizontal spacing between blocks + (setq spacingY 9.0) ; Vertical spacing between rows + (setq dpmOffsetX 5.0) ; X offset for DPM blocks + (setq hdvY 4.0) ; Y position for HDV block + (setq secondCableEnds '()) ; Store vertical line tops + (setq zigzagStarts '()) ; Store zigzag start points + + (command "_.ERASE" "ALL" "") + + + (setq devices (readDeviceListFromFile)) + + (if (not devices) + (progn + (princ "\nNo device file selected or file was empty.") + (exit) + ) + ) + + (setq dpmCount (length devices)) + + ;; Calculate grid size + (setq colCount (fix (sqrt dpmCount))) + (if (< (* colCount colCount) dpmCount) + (setq colCount (+ colCount 1)) + ) + (setq rowCount (fix (/ (+ dpmCount colCount -1) colCount))) + + ;; Calculate centering offset for DPM blocks + (setq gridWidth (* (- colCount 1) spacingX)) + (setq centerOffsetX (- (/ gridWidth 2.0))) + + ;; Insert HDV block at (0, hdvY) on layer 0 + (command "_.LAYER" "S" "0" "") + (command "_.INSERT" hdvBlkName (list 0 hdvY) scaleFactor scaleFactor 0) + + ;; Loop to place blocks and draw lines + (setq i 0) + (repeat dpmCount + (setq row (fix (/ i colCount))) + (setq col (rem i colCount)) + (setq x (+ (* col spacingX) dpmOffsetX)) ; Use variable + (setq y (* -1 row spacingY)) ; No Y offset + (setq dpmName (nth i devices)) ;; get line content + + ;; Insert DPM block on layer 0 + (command "_.LAYER" "S" "0" "") + (command "_.INSERT" blkName (list x y) scaleFactor scaleFactor 0) + + ;; Get the last inserted entity + (setq ent (entlast)) + + ;; Call the function + (updateTagAttribute ent dpmName) + + ;; First cable: vertical up + (setq startPt (list (+ x 7.3656) (+ y 4.4406))) + (setq endPt (list (car startPt) (+ (cadr startPt) 2.0))) + (entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + (setq secondCableEnds (append secondCableEnds (list endPt))) + + ;; Check if last block in row OR last block in entire drawing + (if (or (= (rem (1+ i) colCount) 0) (= i (- dpmCount 1))) + (progn + ;; Last block in row or last block overall — elbow and downward + (setq startPt (list (+ x 7.2677) (+ y 3.6094))) + (setq elbowPt (list (- (car startPt) 0.2) (- (cadr startPt) 0.2))) + (entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 elbowPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + (setq endPt (list (car elbowPt) (- (cadr elbowPt) 4.5))) + (entmakex (list '(0 . "LINE") (cons 10 elbowPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + (setq zigzagStarts (append zigzagStarts (list nil))) ; Placeholder + ) + (progn + ;; Zigzag jump + (setq zigzagStart (list (+ x 7.3656) (+ y 3.7852))) + (setq elbowPt (list (+ x 7.8585) (+ y 5.1262))) + (entmakex (list '(0 . "LINE") (cons 10 zigzagStart) (cons 11 elbowPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Upward line + (setq startPt elbowPt) + (setq endPt (list (car startPt) (+ (cadr startPt) 1.3144))) + (entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Store the end point of the upward line (second cable's end) + (setq zigzagStarts (append zigzagStarts (list endPt))) + ) + ) + + (setq i (1+ i)) + ) + + ;; Connect second cable end to next block's first cable end (if not last in row) + (setq i 0) + (repeat (- dpmCount 1) + (if (/= (rem (1+ i) colCount) 0) ; Only if not last in row + (progn + (setq pt1 (nth i zigzagStarts)) ; Current block's second line end + (setq pt2 (nth (1+ i) secondCableEnds)) ; Next block's first line end + (if (and pt1 pt2 (listp pt1) (listp pt2)) ; Enhanced check + (entmakex + (list + '(0 . "LINE") + (cons 10 pt1) + (cons 11 pt2) + '(62 . 256) + '(8 . "AS_ENET_CABLE") + ) + ) + ) + ) + ) + (setq i (1+ i)) + ) + + ;; Connect last block in row to first block in next row + (setq i 0) + (repeat rowCount + (setq lastInRowIndex (- (* (1+ i) colCount) 1)) ; Last block index in current row + (setq firstInNextRowIndex (* (1+ i) colCount)) ; First block index in next row + + (if (and (< lastInRowIndex dpmCount) (< firstInNextRowIndex dpmCount)) + (progn + ;; Get the downward line end point from last block in row + (setq row i) + (setq col (- colCount 1)) ; Last column + (setq x (+ (* col spacingX) dpmOffsetX)) ; Use variable + (setq y (* -1 row spacingY)) ; Use variable + (setq downwardEndPt (list (- (+ x 7.2677) 0.2) (- (- (+ y 3.6094) 0.2) 4.5))) + + ;; Get first block coordinates in next row + (setq nextRow (1+ i)) + (setq nextCol 0) ; First column + (setq nextX (+ (* nextCol spacingX) dpmOffsetX)) ; Use variable + (setq nextY (* -1 nextRow spacingY)) ; Use variable + (setq nextBlockFirstLineEnd (list (+ nextX 7.3656) (+ (+ nextY 4.4406) 2.0))) + + ;; Draw horizontal line from downward end to next block's X coordinate + (setq horizontalEndPt (list (car nextBlockFirstLineEnd) (cadr downwardEndPt))) + (entmakex (list '(0 . "LINE") (cons 10 downwardEndPt) (cons 11 horizontalEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Draw vertical line up to next block's first line end + (entmakex (list '(0 . "LINE") (cons 10 horizontalEndPt) (cons 11 nextBlockFirstLineEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + ) + ) + (setq i (1+ i)) + ) + ;; Connect first block to HDV block + (if (> dpmCount 0) + (progn + ;; First block coordinates + (setq firstX (+ (* 0 spacingX) dpmOffsetX)) ; First block X + (setq firstY (* -1 0 spacingY)) ; First block Y (row 0) + + ;; First block's first line end point + (setq firstBlockEnd (list (+ firstX 7.3656) (+ (+ firstY 4.4406) 2.0))) + + ;; HDV connection end point + (setq hdvEndPt (list (+ 0 1.4) (- hdvY 2.8))) ; HDV is at (0, hdvY) + + ;; Step 1: Horizontal line to X destination - 0.5 + (setq horizontalEnd (list (+ (car hdvEndPt) 0.5) (cadr firstBlockEnd))) + (entmakex (list '(0 . "LINE") (cons 10 firstBlockEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Step 2: Vertical line to Y destination - 0.5 + (setq verticalEnd (list (car horizontalEnd) (+ (cadr hdvEndPt) 0.5))) + (entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 verticalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Step 3: Final line to HDV end point + (entmakex (list '(0 . "LINE") (cons 10 verticalEnd) (cons 11 hdvEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + ) + ) + + ;; Connect last block to HDV block + (if (> dpmCount 0) + (progn + ;; Last block index and coordinates + (setq lastBlockIndex (- dpmCount 1)) + (setq lastRow (fix (/ lastBlockIndex colCount))) + (setq lastCol (rem lastBlockIndex colCount)) + (setq lastX (+ (* lastCol spacingX) dpmOffsetX)) + (setq lastY (* -1 lastRow spacingY)) + + ;; HDV connection end point for last block + (setq hdvLastEndPt (list (+ 0 0.1) (- hdvY 5.83))) ; HDV is at (0, hdvY) + + ;; Check if we have only one row + (if (= rowCount 1) + (progn + ;; Single row: extend vertical line down by 1.5 units below destination Y, keeping same X + (setq startPt (list (- (+ lastX 7.2677) 0.2) (- (+ lastY 3.6094) 0.2))) + (setq extendedVerticalEnd (list (car startPt) (- (cadr hdvLastEndPt) 1.5))) + (entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 extendedVerticalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Horizontal line LEFT to final destination X + (setq horizontalEnd (list (car hdvLastEndPt) (cadr extendedVerticalEnd))) + (entmakex (list '(0 . "LINE") (cons 10 extendedVerticalEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Vertical line UP to final destination + (entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 hdvLastEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + ) + (progn + ;; Multiple rows: use original 2-segment path + ;; Last block's vertical line end point (downward line end) + (setq lastBlockVerticalEnd (list (- (+ lastX 7.2677) 0.2) (- (- (+ lastY 3.6094) 0.2) 4.5))) + + ;; Step 1: Horizontal line LEFT to X destination + (setq horizontalEnd (list (car hdvLastEndPt) (cadr lastBlockVerticalEnd))) + (entmakex (list '(0 . "LINE") (cons 10 lastBlockVerticalEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + + ;; Step 2: Vertical line to final destination + (entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 hdvLastEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE"))) + ) + ) + ) + ) + + (princ) +) \ No newline at end of file diff --git a/devlay.lsp b/devlay.lsp deleted file mode 100644 index ff8bc5a..0000000 --- a/devlay.lsp +++ /dev/null @@ -1,391 +0,0 @@ -;; 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 mirrorThreshold (if (= blkName "PLCIO_ARMORBLOCK_SIO") 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)) - - (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)))) - (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 mirrorThreshold (if (= blkName "PLCIO_ARMORBLOCK_SIO") 9 7)) - (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 (old behavior) - (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)) - (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 (= blkName "PLCIO_ARMORBLOCK_SIO") - (progn - (setq moveVecX (if (< tagNum mirrorThreshold) 0.5 -1.4)) ; inward move - (setq newX1 (+ (car newPt1) moveVecX)) - (setq newX2 (+ (car newPt2) moveVecX)) - (setq newX3 (+ (car newPt3) moveVecX)) - - (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 (cadr newPt3) (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 (= blkName "PLCIO_ARMORBLOCK_SIO") (>= tagNum 9)) - 0.5 ; right side → move slightly left - (if (= blkName "PLCIO_ARMORBLOCK_SIO") - 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 (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) - ) - ) - - - (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 c:devlay_update () - (delete-existing-devlay-blocks) - (process-block-type "PLCIO_ARMORPOWERFLEX" 11) - (process-block-type "PLCIO_ARMORBLOCK_SIO" 16) - (princ) -) \ No newline at end of file diff --git a/network-diagram-v2.lsp b/network-diagram-v2.lsp index 0e3b1af..c118da5 100644 --- a/network-diagram-v2.lsp +++ b/network-diagram-v2.lsp @@ -167,6 +167,28 @@ (princ) ) +(defun setLayoutWireNumbers (layoutEnt zoneNumber layoutIndex / vlaBlock att tag wireNumber cblIndex) + (if (and layoutEnt (eq (cdr (assoc 0 (entget layoutEnt))) "INSERT")) + (progn + (setq vlaBlock (vlax-ename->vla-object layoutEnt)) + (setq cblIndex 5) ; Start from CBL05 + + (foreach att (vlax-invoke vlaBlock 'GetAttributes) + (setq tag (strcase (vla-get-tagstring att))) + (if (= tag "WIRENO") + (progn + (setq wireNumber (strcat zoneNumber (itoa (+ 702 layoutIndex)) "-CBL" (if (< cblIndex 10) (strcat "0" (itoa cblIndex)) (itoa cblIndex)))) + (vla-put-textstring att wireNumber) + (setq cblIndex (1+ cblIndex)) + ) + ) + ) + ) + (princ "\nInvalid layout entity passed to setLayoutWireNumbers.") + ) + (princ) +) + (defun parseCSVLine (line / pos result) (setq result '()) (while (setq pos (vl-string-search "," line)) @@ -274,9 +296,6 @@ (list dpmList deviceGroups) ) - - - (defun c:init-diagrams ( / blockName count offsetX i x y) (clearDrawing) (setq blockName "layout") @@ -302,10 +321,14 @@ (command "_.-INSERT" blockName basePt 1 1 0) (setq lastEnt (entlast)) (if lastEnt - (vla-move - (vlax-ename->vla-object lastEnt) - (vlax-3d-point basePt) - (vlax-3d-point targetPt) + (progn + (vla-move + (vlax-ename->vla-object lastEnt) + (vlax-3d-point basePt) + (vlax-3d-point targetPt) + ) + ;; Set WIRENO attributes in layout block + (setLayoutWireNumbers lastEnt userInput i) ) ) diff --git a/network-diagram-v3.lsp b/network-diagram-v3.lsp index bae266e..18e1dde 100644 --- a/network-diagram-v3.lsp +++ b/network-diagram-v3.lsp @@ -274,9 +274,6 @@ no (defun clearDrawing ( / ss) (list dpmList deviceGroups) ) - - - (defun c:init-diagrams ( / blockName count offsetX i x y) (clearDrawing) (setq blockName "layout") diff --git a/read-csv.lsp b/read-csv.lsp deleted file mode 100644 index 36f9cfa..0000000 --- a/read-csv.lsp +++ /dev/null @@ -1,175 +0,0 @@ -(defun parseCSVLine (line / pos result) - (setq result '()) - (while (setq pos (vl-string-search "," line)) - (setq result (append result (list (substr line 1 pos)))) - (setq line (substr line (+ pos 2))) - ) - (append result (list line)) -) - -(defun getDPMDataFromCSV ( / file filename line headers row dpm ip name dpmList deviceGroups currentGroup) - (setq filename (getfiled "Select CSV File" (strcat (getenv "USERPROFILE") "\\Desktop\\") "csv" 0)) - (if (not filename) - (progn (princ "\nNo file selected.") (exit)) - ) - (setq file (open filename "r")) - (if (not file) - (progn (princ "\nFailed to open file.") (exit)) - ) - - ;; Read header line - (read-line file) - (setq dpmList '()) - (setq deviceGroups '()) - (setq currentGroup '()) - - (while (setq line (read-line file)) - (setq row (parseCSVLine line)) - - ;; DPM name and IP - (setq dpm (nth 0 row)) - (setq ip (nth 1 row)) - - ;; Debug output - (princ (strcat "\nProcessing: DPM=" (if dpm dpm "NIL") " IP=" (if ip ip "NIL"))) - - ;; Add unique DPM to list - (if (and dpm (/= dpm "") (not (assoc dpm dpmList))) - (progn - (setq dpmList (append dpmList (list (cons dpm ip)))) - (princ (strcat "\nAdded new DPM: " dpm " with IP: " ip)) - ) - ) - - ;; Device NAME (column 2) - (setq name (nth 2 row)) - (if (and name (/= name "")) - (progn - (setq currentGroup (append currentGroup (list name))) - (princ (strcat "\nAdded device: " name " (Group size: " (itoa (length currentGroup)) ")")) - ) - ) - - ;; Once 8 devices are collected, add to deviceGroups - (if (= (length currentGroup) 8) - (progn - (setq deviceGroups (append deviceGroups (list currentGroup))) - (princ (strcat "\nCompleted group " (itoa (length deviceGroups)) " with 8 devices")) - (setq currentGroup '()) - ) - ) - ) - - - (close file) - (list dpmList deviceGroups) -) - -(defun printDPMData (dpmList deviceGroups / i dpm ip devices device) - (princ "\n--- DPM Data ---") - (princ (strcat "\nTotal DPMs: " (itoa (length dpmList)))) - (princ (strcat "\nTotal Device Groups: " (itoa (length deviceGroups)))) - - (setq i 0) - (foreach dpm dpmList - (princ (strcat "\n\nDPM: " (car dpm))) - (princ (strcat "\nIP: " (cdr dpm))) - (princ "\nDevices:") - - (if (< i (length deviceGroups)) - (progn - (setq devices (nth i deviceGroups)) - (foreach device devices - (princ (strcat "\n - " device)) - ) - ) - (princ "\n No devices found for this DPM") - ) - (setq i (1+ i)) - ) - (princ "\n--- End of Data ---") -) - -(defun createTextObjects (dpmList deviceGroups / i dpm ip devices device yPos xPos textContent startY row col) - (setq yPos 0) - (setq xPos 0) - (setq i 0) - - (princ "\nCreating text objects...") - - (foreach dpm dpmList - (setq startY yPos) - - ;; Create text for DPM name - (setq textContent (strcat "DPM: " (car dpm))) - (command "TEXT" (list xPos yPos) "2.5" "0" textContent) - (setq yPos (- yPos 5)) - - ;; Create text for IP - (setq textContent (strcat "IP: " (cdr dpm))) - (command "TEXT" (list xPos yPos) "2.0" "0" textContent) - (setq yPos (- yPos 4)) - - ;; Create text for devices in 4x2 grid - (if (< i (length deviceGroups)) - (progn - (setq devices (nth i deviceGroups)) - (setq row 0) - (setq col 0) - - (foreach device devices - ;; Calculate position: 4 rows, 2 columns - ;; Devices 1,2,3,4 go in left column (col 0) - ;; Devices 5,6,7,8 go in right column (col 1) - (if (< row 4) - (setq col 0) - (progn - (setq col 1) - (setq row (- row 4)) - ) - ) - - ;; Position: left column at xPos, right column at xPos + 40 - ;; Each row is 3 units apart - (setq textContent device) - (command "TEXT" - (list (+ xPos (* col 40)) (- yPos (* row 3))) - "1.5" - "0" - textContent - ) - (setq row (1+ row)) - ) - ) - ) - - ;; Move down for next DPM (leave space for 4 rows + extra spacing) - (setq yPos (- yPos 20)) - - ;; Move to next column if too many entries - (if (< yPos -200) - (progn - (setq xPos (+ xPos 120)) - (setq yPos 0) - ) - ) - - (setq i (1+ i)) - ) - - (princ "\nText objects created successfully!") -) - -(defun c:getDPMsWithNamesFromCSV ( / result dpmList deviceGroups) - (setq result (getDPMDataFromCSV)) - (setq dpmList (nth 0 result)) - (setq deviceGroups (nth 1 result)) - - ;; Print the data - (printDPMData dpmList deviceGroups) - - ;; Create text objects - (createTextObjects dpmList deviceGroups) - - (princ) -) \ No newline at end of file