commit 666728a819e89ab2a57c7ea1e933fc1a4640a268 Author: Salijoghli <107577102+Salijoghli@users.noreply.github.com> Date: Wed Jul 23 20:57:16 2025 +0400 starting point of the autocad scripts diff --git a/block-dimensions.lsp b/block-dimensions.lsp new file mode 100644 index 0000000..1e49a1a --- /dev/null +++ b/block-dimensions.lsp @@ -0,0 +1,38 @@ +(defun c:GetBlockDimensions ( / ss ent vlaObj minPt maxPt width height txtStr insPt) + (setq ss (ssget "_+.:S" '((0 . "INSERT")))) ; Select a block + (if ss + (progn + (setq ent (ssname ss 0)) + (setq vlaObj (vlax-ename->vla-object ent)) + (vla-GetBoundingBox vlaObj 'minPt 'maxPt) + (setq minPt (vlax-safearray->list minPt)) + (setq maxPt (vlax-safearray->list maxPt)) + + ;; Calculate width and height + (setq width (- (car maxPt) (car minPt))) + (setq height (- (cadr maxPt) (cadr minPt))) + + ;; Build string like "120.50 x 75.30" + (setq txtStr (strcat (rtos width 2 2) " x " (rtos height 2 2))) + + ;; Ask user where to place the label + (setq insPt (getpoint "\nPick insertion point for label: ")) + + ;; Create the text entity + (entmakex + (list + '(0 . "TEXT") + (cons 10 insPt) + (cons 40 2.5) ; Text height + (cons 1 txtStr) + (cons 7 "Standard") ; Text style + (cons 8 "0") ; Layer + ) + ) + + (princ (strcat "\nLabeled block as: " txtStr)) + ) + (princ "\nNo block selected.") + ) + (princ) +) diff --git a/devlay-v2.lsp b/devlay-v2.lsp new file mode 100644 index 0000000..3fdc6c7 --- /dev/null +++ b/devlay-v2.lsp @@ -0,0 +1,440 @@ +;; 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 sioLikeBlocks '("PLCIO_ARMORBLOCK_SIO" "PLCIO_ARMBLOCK_FIOM" "PLCIO_ARMORBLOCK_FIOH")) + (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 taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6)))) + (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)))) + (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 + ) + ) + + ;; 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 + (setq newX1 (+ (car newPt1) moveVecX)) + (setq newX2 (+ (car newPt2) moveVecX)) + (setq newX3 + (if (or (= tagNum 7) (= tagNum 8)) + (+ (car newPt3) -1.5) + (+ (car newPt3) moveVecX) + ) + ) + (setq newY3 + (if (or (= tagNum 7) (= tagNum 8)) + (+ (cadr newPt3) -0.015) + (cadr newPt3) + ) + ) + + (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))) + ) + ) + ) + ) + ) + ) + + (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.5 ; 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 (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) + (process-block-type "PLCIO_ARMBLOCK_FIOM" 16) + (process-block-type "PLCIO_ARMORBLOCK_FIOH" 16) + (princ) +) \ No newline at end of file diff --git a/devlay.lsp b/devlay.lsp new file mode 100644 index 0000000..ff8bc5a --- /dev/null +++ b/devlay.lsp @@ -0,0 +1,391 @@ +;; 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/layout-base-v2.lsp b/layout-base-v2.lsp new file mode 100644 index 0000000..732f472 --- /dev/null +++ b/layout-base-v2.lsp @@ -0,0 +1,305 @@ +(defun clearDrawing ( / ss) + ;; Select all non-locked, visible entities and delete them + (setq ss (ssget "_X" '((0 . "*")))) ; select all + (if ss + (progn + (command "_.erase" ss "") + (princ "\nDrawing cleared.") + ) + ) +) + +(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))) + ;; Use the block's X position + 0.5, and Y from the attribute + (setq basePt (vlax-get att 'InsertionPoint)) + (setq blockPos (vlax-get block 'InsertionPoint)) ; block base point + + ;; X from block + 0.5, Y from attribute - 0.05 + (setq labelPt (list (+ (car blockPos) 0.12) (- (cadr basePt) 0.053) (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))) + + (setq labelText + (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 "") + ) + ) + + (if (/= labelText "") + (progn + ;; Create text entity with alignment point for justification + (setq ent (entmakex + (list + (cons 0 "TEXT") + (cons 8 "0") + (cons 7 "WD") + (cons 62 7) ;; white color + (cons 10 labelPt) ;; insertion point + (cons 11 labelPt) ;; alignment point (required for vertical just >0) + (cons 40 0.5) + (cons 72 0) ;; Horizontal Left + (cons 73 3) ;; Vertical Top + (cons 1 labelText) + (cons 50 0.0) ;; rotation angle + ) + )) + ) + ) +) + +;; 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 + (setq filePath (getfiled "Select Device List File" "" "txt" 0)) + (if filePath + (progn + (setq file (open filePath "r")) + (while (setq line (read-line file)) + (setq result (append result (list (strcase (vl-string-trim " \t\r\n" line))))) + ) + (close file) + result + ) + nil + ) +) + +;; Function to chunk a list into sublists of specified size + +(defun chunk-list (lst size / result chunk) + (while lst + (setq chunk (vl-remove-if 'null (list (nth 0 lst) (nth 1 lst) (nth 2 lst) (nth 3 lst)))) + (setq result (append result (list chunk))) + (setq lst (cddddr lst)) + ) + result +) + +;; Function to read device list from file and return as a list +(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 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 + ;; 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 + (progn + (setq vlaEnt (vlax-ename->vla-object ent)) + (vla-move vlaEnt (vlax-3d-point 0 0 0) (vlax-3d-point pos)) + (setDESCAtoSpare vlaEnt) + (placeDeviceLabel vlaEnt) + ) + (princ (strcat "\nFailed to insert block: " blk)) + ) + ) + ) + + (setq i (1+ i)) + ) +) + + +(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue / blockObj attrList attr attrName newValue) + + (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, add index + (setq newValue (+ (atoi startValue) layoutIndex)) + + ;; Format as 5-digit string with leading zeros, add "." + (setq newValue (strcat (substr (strcat "00000" (itoa newValue)) (- (strlen (strcat "00000" (itoa newValue))) 4)) ".")) + + ;; Apply value + (vlax-put-property attr 'TextString newValue) + (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)) ; + (setq groupedData (chunk-list layoutData 4)) + (setq layoutCount (length groupedData)) + + ;; Clear drawing and setup + (clearDrawing) + (setq oldAttReq (getvar "ATTREQ")) + (setvar "ATTREQ" 0) + (setq offsetX 38.5) + + ;; Layout loop + (setq i 0) + (while (< i layoutCount) + (setq currentOffset (* i offsetX)) + + ;; Draw outer box + (command "_.PLINE" (list (+ 0 currentOffset) -11.0)) + (command (list (+ 38.5 currentOffset) -11.0)) + (command (list (+ 38.5 currentOffset) 11.0)) + (command (list (+ 0 currentOffset) 11.0)) + (command "C") + + ;; Side and center lines + (command "_.PLINE" (list (+ 0 currentOffset) -11.0) (list (+ 0 currentOffset) 11.0) "") + (command "_.PLINE" (list (+ 38.5 currentOffset) -11.0) (list (+ 38.5 currentOffset) 11.0) "") + (command "_.PLINE" (list (+ 19.25 currentOffset) -11.0) (list (+ 19.25 currentOffset) 11.0) "") + + ;; Insert 20_zone blocks + (setq basePt '(0 0 0)) + (setq ptLeft (list (+ 0.75 currentOffset) 9.5 0)) + (setq ptRight (list (+ 20.0 currentOffset) 9.5 0)) + + (setq leftEnt (insertBlockAt "20_zone" basePt ptLeft)) + (setq leftBlock (vlax-ename->vla-object leftEnt)) + (update20ZoneBlockAttributes leftEnt i "04600") + (labelBlockLines leftBlock 1) + + (setq rightEnt (insertBlockAt "20_zone" basePt ptRight)) + (setq rightBlock (vlax-ename->vla-object rightEnt)) + (update20ZoneBlockAttributes rightEnt i "04600") + (labelBlockLines rightBlock 21) + + ;; Add layout label + (setq labelPt (list (+ currentOffset 14.0) 16.0 0.0)) + (command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ i)))) + + ;; Insert actual devices from group + (placeDevicesInLayout currentOffset (nth i groupedData)) + + (setq i (1+ i)) + ) + + ;; Reset + (command "_.color" "BYLAYER") + (setvar "ATTREQ" oldAttReq) + (princ (strcat "\n" (itoa layoutCount) " layouts created from file.")) + (princ) +) + diff --git a/layout-base.lsp b/layout-base.lsp new file mode 100644 index 0000000..4275415 --- /dev/null +++ b/layout-base.lsp @@ -0,0 +1,231 @@ +(defun clearDrawing ( / ss) + ;; Select all non-locked, visible entities and delete them + (setq ss (ssget "_X" '((0 . "*")))) ; select all + (if ss + (progn + (command "_.erase" ss "") + (princ "\nDrawing cleared.") + ) + ) +) + +(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))) + + (setq labelText + (cond + ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*POWERFLEX*") "APF") + ((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*SIO*") "SIO") + (T "") + ) + ) + + (if (/= labelText "") + (progn + ;; Create text entity with alignment point for justification + (setq ent (entmakex + (list + (cons 0 "TEXT") + (cons 8 "0") + (cons 7 "WD") + (cons 62 7) ;; white color + (cons 10 labelPt) ;; insertion point + (cons 11 labelPt) ;; alignment point (required for vertical just >0) + (cons 40 0.5) + (cons 72 0) ;; Horizontal Left + (cons 73 3) ;; Vertical Top + (cons 1 labelText) + (cons 50 0.0) ;; rotation angle + ) + )) + ) + ) +) + +;; 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 + (setq filePath (getfiled "Select Device List File" "" "txt" 0)) + (if filePath + (progn + (setq file (open filePath "r")) + (while (setq line (read-line file)) + (setq result (append result (list (strcase (vl-string-trim " \t\r\n" line))))) + ) + (close file) + result + ) + nil + ) +) + +;; Function to chunk a list into sublists of specified size + +(defun chunk-list (lst size / result chunk) + (while lst + (setq chunk (vl-remove-if 'null (list (nth 0 lst) (nth 1 lst) (nth 2 lst) (nth 3 lst)))) + (setq result (append result (list chunk))) + (setq lst (cddddr lst)) + ) + result +) + +;; Function to read device list from file and return as a list +(defun placeDevicesInLayout (layoutStartX devices / basePt positions i blk pos ent) + (setq basePt "0,0,0") + + + (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 + )) + + (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") + (T nil) + ) + ) + + (if blk + (progn + (setq pos (nth i positions)) + (command "_.-INSERT" blk basePt 1 1 0) + (setq ent (entlast)) + (if ent + (progn + (setq vlaEnt (vlax-ename->vla-object ent)) + (vla-move vlaEnt (vlax-3d-point 0 0 0) (vlax-3d-point pos)) + (setDESCAtoSpare vlaEnt) + (placeDeviceLabel vlaEnt) + ) + (princ (strcat "\nFailed to insert block: " blk)) + ) + ) + ) + + (setq i (1+ i)) + ) +) + + +(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 groupedData (chunk-list layoutData 4)) + (setq layoutCount (length groupedData)) + + ;; Clear drawing and setup + (clearDrawing) + (setq oldAttReq (getvar "ATTREQ")) + (setvar "ATTREQ" 0) + (setq offsetX 38.5) + + ;; Layout loop + (setq i 0) + (while (< i layoutCount) + (setq currentOffset (* i offsetX)) + + ;; Draw outer box + (command "_.PLINE" (list (+ 0 currentOffset) -11.0)) + (command (list (+ 38.5 currentOffset) -11.0)) + (command (list (+ 38.5 currentOffset) 11.0)) + (command (list (+ 0 currentOffset) 11.0)) + (command "C") + + ;; Side and center lines + (command "_.PLINE" (list (+ 0 currentOffset) -11.0) (list (+ 0 currentOffset) 11.0) "") + (command "_.PLINE" (list (+ 38.5 currentOffset) -11.0) (list (+ 38.5 currentOffset) 11.0) "") + (command "_.PLINE" (list (+ 19.25 currentOffset) -11.0) (list (+ 19.25 currentOffset) 11.0) "") + + ;; Insert 20_zone blocks + (setq basePt '(0 0 0)) + (setq ptLeft (list (+ 0.75 currentOffset) 9.5 0)) + (setq ptRight (list (+ 20.0 currentOffset) 9.5 0)) + + (setq leftEnt (insertBlockAt "20_zone" basePt ptLeft)) + (setq leftBlock (vlax-ename->vla-object leftEnt)) + (labelBlockLines leftBlock 1) + + (setq rightEnt (insertBlockAt "20_zone" basePt ptRight)) + (setq rightBlock (vlax-ename->vla-object rightEnt)) + (labelBlockLines rightBlock 21) + + ;; Add layout label + (setq labelPt (list (+ currentOffset 14.0) 16.0 0.0)) + (command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ i)))) + + ;; Insert actual devices from group + (placeDevicesInLayout currentOffset (nth i groupedData)) + + (setq i (1+ i)) + ) + + ;; Reset + (command "_.color" "BYLAYER") + (setvar "ATTREQ" oldAttReq) + (princ (strcat "\n" (itoa layoutCount) " layouts created from file.")) + (princ) +) + diff --git a/network-diagram-v2.lsp b/network-diagram-v2.lsp new file mode 100644 index 0000000..7c9ead9 --- /dev/null +++ b/network-diagram-v2.lsp @@ -0,0 +1,371 @@ +(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) "*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.9) ; 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)) + + + (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)) + ;; Label the ZONE_32H lines + (labelZone32Lines ent) + (setq insPt targetPt) + (setq revTriPt (list (+ (car insPt) 42.7) (+ (cadr insPt) desiredY) (caddr insPt))) + (command "_.-INSERT" "REVTRIANGLE2" revTriPt 1 0 1) + ) + ) + + ;; 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/network-diagram.lsp b/network-diagram.lsp new file mode 100644 index 0000000..35567ca --- /dev/null +++ b/network-diagram.lsp @@ -0,0 +1,331 @@ +(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) "*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 x (+ 17.0 (* i width))) + (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.9) ; 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 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)) + + ;; Add unique DPM to list + (if (and dpm (/= dpm "") (not (assoc dpm dpmList))) + (progn + (setq dpmList (append dpmList (list (cons dpm ip)))) + ) + ) + + ;; Device NAME and IP (columns 2 and 4) + (setq name (nth 2 row)) + (setq deviceIP (nth 4 row)) + (setq port (nth 6 row)) + (if (and name (/= name "")) + (progn + ;; Store pair: (name . deviceIP) + (setq currentGroup + (append currentGroup + (list (list + (cons "NAME" name) + (cons "IP" deviceIP) + (cons "PORT" port) + )) + ) + ) + ) + ) + + ;; Once 8 devices are collected, add to deviceGroups + (if (= (length currentGroup) 8) + (progn + (setq deviceGroups (append deviceGroups (list currentGroup))) + (setq 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)) + + + (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 15.85) (+ y 2.5) 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)) + ;; Label the ZONE_32H lines + (labelZone32Lines ent) + (setq insPt targetPt) + (setq revTriPt (list (+ (car insPt) 42.7) (+ (cadr insPt) desiredY) (caddr insPt))) + (command "_.-INSERT" "REVTRIANGLE2" revTriPt 1 0 1) + ) + ) + + ;; 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/network-v2.lsp b/network-v2.lsp new file mode 100644 index 0000000..d7f25b5 --- /dev/null +++ b/network-v2.lsp @@ -0,0 +1,645 @@ +(defun clearDrawing ( / ss) + ;; Select all visible, non-locked entities and delete them + (setq ss (ssget "_X" '((0 . "*")))) ; select everything + (if ss + (progn + (command "_.erase" ss "") + (princ "\nDrawing cleared.") + ) + ) +) +(defun getGap (count) + (cond + ((<= count 20) 3.95) + ((< count 25) 3.5) + ((< count 36) 2.2) + ((>= count 36) 1.3) + ) +) + +(defun getFinalOffsetY (numBlocks) + (cond + ((>= numBlocks 36) 12.0) + ((>= numBlocks 25) 11.5) + (T 10.5) + ) +) + + +;; Function to get final stop for "new block" with negative XScale +(defun getFinalStopNewBlock ( / ss i ent obj xScale insPt finalX finalY finalZ finalStop) + (vl-load-com)` + (setq ss (ssget "X" '((0 . "INSERT") (2 . "new block")))) + (if (and ss (> (sslength ss) 0)) + (progn + (setq i 0) + (while (< i (sslength ss)) + (setq ent (ssname ss i)) + (setq obj (vlax-ename->vla-object ent)) + (setq xScale (vlax-get obj 'XScaleFactor)) + (if (< xScale 0.0) + (progn + ;; Get block insertion point and calculate final stop + (setq insPt (vlax-get obj 'InsertionPoint)) + (setq finalX (+ (car insPt) 0.578)) + (setq finalY (- (cadr insPt) 0.0072)) + (setq finalZ (nth 2 insPt)) + (setq finalStop (list finalX finalY finalZ)) + + (setq i (sslength ss)) ; exit loop early + ) + ) + (setq i (1+ i)) + ) + finalStop ; return + ) + ) +) + + +(defun getFinalStopSecondNewBlock () + (vl-load-com) + (setq finalStop nil) + ;; Get selection set of all "new block" inserts + (setq ss (ssget "X" '((0 . "INSERT") (2 . "new block")))) + (if (and ss (> (sslength ss) 0)) + (progn + (setq i 0) + (while (< i (sslength ss)) + (setq ent (ssname ss i)) + (setq obj (vlax-ename->vla-object ent)) + ;; Get X scale + (setq xScale (vlax-get obj 'XScaleFactor)) + (if (> xScale 0.0) ;; positive X scale = second block + (progn + ;; Found second block + (setq insPt (vlax-get obj 'InsertionPoint)) ; list of 3 coords + (setq finalX (- (car insPt) 0.578)) + (setq finalY (- (cadr insPt) 0.0072)) + (setq finalStop (list finalX finalY (last insPt))) + (setq i (sslength ss)) ; exit loop + ) + ) + (setq i (1+ i)) + ) + ) + ) + finalStop +) + + +(defun drawHorizontalToFinalStop (startPt targetX) + (setq endPt (list targetX (cadr startPt) (caddr startPt))) + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; Layer 0 + (cons 62 3) ; Green color + (cons 10 startPt) + (cons 11 endPt) + ) + ) +) + +(defun labelLine (pt1 pt2 index moveRight? / midPt labelText offsetPt) + ;; Compose label text + (setq labelText (strcat "8911-CBL " (itoa index))) + + ;; Calculate midpoint + (setq midPt (list (/ (+ (car pt1) (car pt2)) 2.0) + (/ (+ (cadr pt1) (cadr pt2)) 2.0) + 0.0)) + + ;; Apply offset: if moveRight? then +2 in X, else -1 in X, and -0.05 in Y + (setq offsetPt (list (+ (car midPt) (if moveRight? 1.5 -1.0)) + (- (cadr midPt) 0.05) + 0.0)) + + ;; Create the text entity + (entmake + (list + (cons 0 "TEXT") + (cons 8 "0") + (cons 10 offsetPt) + (cons 40 0.3) ; text height + (cons 1 labelText) + (cons 7 "Standard") ; style + (cons 72 1) ; left justified + (cons 73 1) ; middle baseline + (cons 11 offsetPt) + ) + ) +) + + +(defun drawZigzagCables (connectorData targetPt centerOffset numBlocks / sorted i pt1 pt2 direction yDown turnPoint cur next moveTo) + (setq lineIndex 2) + (setq greenColor 3) ; green + + ;; Calculate movement offset (same as blocks) + (setq moveTo + (list + (+ (car centerOffset) (if (>= numBlocks 36) 20.0 23.0)) + (+ (cadr centerOffset) (getFinalOffsetY numBlocks)) + 0.0 + ) + ) + + ;; Sort connectorData in snake order + (setq sorted + (vl-sort connectorData + (function + (lambda (a b) + (cond + ((< (car a) (car b)) T) ; row + ((> (car a) (car b)) nil) + ;; same row, order by column - reversed for odd rows + ((= (rem (car a) 2) 1) (> (cadr a) (cadr b))) + (T (< (cadr a) (cadr b))) + ) + ) + ) + ) + ) + (setq i 0) + (while (and (< i (length sorted))) + + (setq cur (nth i sorted)) + (setq next (nth (1+ i) sorted)) + (setq isOddRow (= (rem (car cur) 2) 1)) + + ;; Check if current block is the last in its row + (if (or (= i (1- (length sorted))) ; last block overall + (and next (/= (car cur) (car next)))) ; or next block is in different row + (progn + ;; Get start point: x2 for even row, x1 for odd row + (setq pt1 (mapcar '+ (list (if isOddRow (nth 2 cur) (nth 3 cur)) (nth 4 cur) 0.0) moveTo)) + + ;; Step 1: short horizontal (1 unit left or right) + (setq horizOffset (if isOddRow -3.0 1.0)) + (setq pt2 (list (+ (car pt1) horizOffset) (cadr pt1) 0.0)) + (setq shouldLabel T) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt1) (cons 11 pt2))) + (setq shouldMoveRight (and (not isOddRow) ; even row + (or (= i (1- (length sorted))) ; last block overall + (and next (/= (car cur) (car next))))) ; or last in row + ) + + (if shouldLabel (labelLine pt1 pt2 lineIndex shouldMoveRight)) + (setq lineIndex (1+ lineIndex)) + + ;; Step 2: vertical drop if there's a next block + (if next + (progn + (setq shouldLabel nil) + (setq pt3 (list (car pt2) (+ (cadr moveTo) (nth 4 next)) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt2) (cons 11 pt3))) + + ;; Step 3: horizontal to connector of next block + (setq pt4 (list (if isOddRow (nth 2 next) (nth 3 next)) (nth 4 next) 0.0)) + + (setq pt4 (mapcar '+ pt4 moveTo)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt3) (cons 11 pt4))) + + ) + ) + ) + ) + + ;; Horizontal connection to next block in same row + (if (and next (= (car cur) (car next))) ; same row + (progn + ;; Choose correct x sides for direction + (if isOddRow + (progn + ;; right to left + (setq pt1 (mapcar '+ (list (nth 2 cur) (nth 4 cur) 0.0) moveTo)) ; x1 cur + (setq pt2 (mapcar '+ (list (nth 3 next) (nth 4 next) 0.0) moveTo)) ; x2 next + ) + (progn + ;; left to right + (setq pt1 (mapcar '+ (list (nth 3 cur) (nth 4 cur) 0.0) moveTo)) ; x2 cur + (setq pt2 (mapcar '+ (list (nth 2 next) (nth 4 next) 0.0) moveTo)) ; x1 next + ) + ) + (setq shouldLabel T) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt1) (cons 11 pt2))) + (if shouldLabel (labelLine pt1 pt2 lineIndex f)) + (setq lineIndex (1+ lineIndex)) + ) + ) + + (setq i (1+ i)) + ) + + ;; Draw extra for last block + (setq lastIndex (1- (length sorted))) + (setq lastBlock (nth lastIndex sorted)) + (setq rowNum (car lastBlock)) + (setq isEvenRow (= (rem rowNum 2) 0)) + + ;; Only draw the extra if last block didn't already connect downward + (if (= lastIndex (1- (length sorted))) ; true last block + (if isEvenRow + (progn + (setq finalStop (getFinalStopNewBlock)) + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + ;; EVEN row: x2 → right 1 → down 1 + (setq pt1 (mapcar '+ (list (nth 3 lastBlock) (nth 4 lastBlock) 0.0) moveTo)) ; x2 + (setq pt2 (list (+ (car pt1) 1.0) (cadr pt1) 0.0)) ; right 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt1) (cons 11 pt2))) + + (setq pt3 (list (car pt2) (- (cadr pt2) 1.0) 0.0)) ; down 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt2) (cons 11 pt3))) + + ;; Step 3: go left to near finalStop.x + (setq xTarget (+ (car finalStop) 1.0)) + (setq pt4 (list xTarget (cadr pt3) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt3) (cons 11 pt4))) + + ;; Step 4: vertical to finalStop.y + (setq pt5 (list xTarget (cadr finalStop) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt4) (cons 11 pt5))) + + ;; Step 5: final horizontal to exact finalStop.x + (setq pt6 (list (car finalStop) (cadr finalStop) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt5) (cons 11 pt6))) + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) + ) + (progn + (setq finalStop (getFinalStopNewBlock)) + + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + ;; Get x1 of last block + movement + (setq pt1 (mapcar '+ (list (nth 2 lastBlock) (nth 4 lastBlock) 0.0) moveTo)) + + ;; Calculate X target (1 unit before finalStop X) + (setq xTarget (+ (car finalStop) 1.0)) + + ;; Horizontal point (end of first line) + (setq horizPt (list xTarget (cadr pt1) 0.0)) + + ;; Vertical line end + (setq vertPt (list xTarget (cadr finalStop) 0.0)) + + ;; Draw horizontal + (drawHorizontalToFinalStop pt1 xTarget) + + ;; Draw vertical + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 horizPt) + (cons 11 vertPt))) + ;; Final horizontal: to reach exact finalStop X + (setq finalPt (list (car finalStop) (cadr finalStop) 0.0)) + + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 vertPt) + (cons 11 finalPt))) + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) + ) + ) + ) + + ;; Draw extra line for first block (x1 → left until aligned with final route) + (setq finalStop (getFinalStopNewBlock)) + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + (setq firstBlock (car sorted)) + (setq pt1 (mapcar '+ (list (nth 2 firstBlock) (nth 4 firstBlock) 0.0) moveTo)) ; x1 + (setq targetX (+ (car finalStop) 1.0)) ; align with the rest + (setq pt2 (list targetX (cadr pt1) 0.0)) ; same Y, just X target + + ;; Draw the horizontal line + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt1) (cons 11 pt2))) + (setq pt3 (list (car pt2) (+ (cadr finalStop) 2.0) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt2) (cons 11 pt3))) + + ;; Draw line label + (labelLine pt1 pt2 1 f)\ + + ;; Now get second final stop and add horizontal line from pt3 to second final stop X + 1 + (setq finalStop2 (getFinalStopSecondNewBlock)) + (if finalStop2 + (progn + ;; Print debug info for second stop + (prompt (strcat "\nSecond Final stop X: " (rtos (car finalStop2) 2 4) + ", Y: " (rtos (cadr finalStop2) 2 4) + ", Z: " (rtos (caddr finalStop2) 2 4))) + + ;; Target point for second horizontal line (to second final stop X + 1, same Y as pt3) + (setq pt4 (list (- (car finalStop2) 1.0) (cadr pt3) 0.0)) + + ;; Draw horizontal line to second final stop X + 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt3) (cons 11 pt4))) + + ;; Draw vertical line down from pt4 to finalStop2 Y (keeping pt4.X) + (setq vertPt (list (car pt4) (cadr finalStop2) 0.0)) + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 pt4) + (cons 11 vertPt))) + + ;; Draw horizontal line from vertPt to finalStop2 (full X and Y) + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 vertPt) + (cons 11 finalStop2))) + ) + (prompt "\nError: finalStop2 is NIL! 'new block' with positive XScale not found.") + ) + + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) +) + +(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 c:Init_Network ( / numBlocks cols rows i row col x y + spacing gap baseGap totalWidth totalHeight + xStart yStart basePt targetPt ent blkRef + attList centerOffset) + + ;; Clear everything first + (clearDrawing) + + + (setq deviceList (readDeviceListFromFile)) + (if (not deviceList) + (progn + (princ "\nError: Device list file not found or empty.") + (exit) + ) + ) + + (setq numBlocks (length deviceList)) + + ; Grid dimensions + (setq rows (fix (sqrt numBlocks))) ; fewer rows + (setq cols (fix (/ (+ numBlocks rows -1) rows))) ; more columns + + (if (or (= numBlocks 25) (= numBlocks 36)) + (setq cols (1+ cols)) + ) + ;; Dynamic gap + (setq gap (getGap numBlocks)) + (setq spacing 3.0) + (setq step (+ spacing gap)) ; actual distance between blocks + + ;; Insert background grid block + (setvar "CLAYER" "AS_GRID") + (setq basePt "0,0,0") + (command "_-INSERT" "A$Cae272396" basePt 1 1 0) + + ;; UPS block layer and setup + (setvar "CLAYER" "AS_ENET CABLE") + (setvar "ATTDIA" 0) + (setvar "ATTREQ" 0) + + ;; Calculate offsets for centering + (setq totalWidth (* cols step)) + (setq totalHeight (* rows step)) + (setq xStart (- (/ totalWidth 2.0))) + (setq yStart (/ totalHeight 2.0)) + (setq centerOffset (list (/ spacing 2.0) (/ spacing 2.0) 0.0)) + + (setq extraColGap (if (>= numBlocks 36) 0.75 0.0)) + (setq i 0) + ;; Place UPS blocks + (while (< i numBlocks) + (setq row (/ i cols)) + (setq col (rem i cols)) + + ;; Snake pattern + (if (= (rem row 2) 1) + (setq col (- cols 1 col)) + ) + + ;; Grid point + (setq x (+ xStart (* col step) (* col extraColGap))) + (setq y (- yStart (* row step))) + (setq targetPt (list x y 0)) + + ;; Insert block at 0,0 and scale + (command "_-INSERT" "UPS_DPM_BRACKET" "0,0,0" 0.2212 0.2212 0.2212 0) + (setq ent (entlast)) + (if ent + (setq blkRef (vlax-ename->vla-object ent)) + (princ "\nError: Block insert failed.") + ) + + ;; Move to adjusted centered position + (setq moveTo + (mapcar '+ targetPt + (list + (+ (car centerOffset) (if (>= numBlocks 36) 20.0 23.0)) + (+ (cadr centerOffset) (getFinalOffsetY numBlocks)) + 0.0 + ) + ) + ) + (vla-move blkRef (vlax-3d-point '(0 0 0)) (vlax-3d-point moveTo)) + + ;; Get device name for current block + (setq deviceName (nth i deviceList)) + + ;; Set TAG2 attribute to zigzag index + (setq attList (vlax-invoke blkRef 'GetAttributes)) + (foreach att attList + (if (= (strcase (vla-get-TagString att)) "TAG2") + (vla-put-TextString att deviceName) + ) + ) + + ;; === Draw connector lines === + (setq start1 (list (+ (car moveTo) 3.99) (- (cadr moveTo) 3.196) 0.0)) + (setq end1 (list (car start1) (- (cadr start1) 0.25) 0.0)) + + (setq start2 (list (+ (car moveTo) 4.155) (cadr start1) 0.0)) + (setq end2 (list (car start2) (- (cadr start2) 0.25) 0.0)) + + (setvar "CLAYER" "0") ; or create a special cable layer if needed + (setq greenColor 3) ; AutoCAD color index for green + + ;; Draw first line + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; layer + (cons 62 greenColor) ; color + (cons 10 start1) + (cons 11 end1) + ) + ) + + ;; Draw second line + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; layer + (cons 62 greenColor) + (cons 10 start2) + (cons 11 end2) + ) + ) + + (setq i (1+ i)) + ) + + ;; Layer and attribute prompt settings + (setvar "CLAYER" "PSYMS") + (setvar "ATTDIA" 0) + (setvar "ATTREQ" 0) + + ;; Target positions + (setq ptTop (list 1.0 16.0 0.0)) ; Top block + (setq ptBot (list 1.86 10.0 0.0)) ; Bottom block + + ;; If block count is 16 or less, shift X positions by +4.0 + (cond + ((<= numBlocks 16) + (setq ptTop (list (+ (car ptTop) 4.0) (cadr ptTop) (caddr ptTop))) + (setq ptBot (list (+ (car ptBot) 4.0) (cadr ptBot) (caddr ptBot)))) + + ((and (>= numBlocks 25) (< numBlocks 31)) + (setq ptTop (list (+ (car ptTop) 3.0) (cadr ptTop) (caddr ptTop))) + (setq ptBot (list (+ (car ptBot) 3.0) (cadr ptBot) (caddr ptBot)))) + ) + + ;; Insert top block (1783-BMS20CGL) + (command "_-INSERT" "1783-BMS20CGL" "0,0,0" 0.75 0.75 0.75 0) + (setq blk1 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation blk1 0.0) ; <- Force zero rotation + (vla-move blk1 (vlax-3d-point '(0 0 0)) (vlax-3d-point ptTop)) + + ;; Insert bottom block (PATCH_PANEL) + (command "_-INSERT" "PATCH_PANEL" "0,0,0" 0.75 0.75 0.75 0) + (setq blk2 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation blk2 0.0) ; <- Force zero rotation + (vla-move blk2 (vlax-3d-point '(0 0 0)) (vlax-3d-point ptBot)) + + ;; Calculate new Y position based on second block (PATCH_PANEL) + (setq newBlockY (+ (cadr ptBot) 1.3702)) + + ;; X positions relative to second block X + (setq newBlock1X (+ (car ptBot) 0.4274)) + (setq newBlock2X (+ (car ptBot) 1.5219)) + + ;; Y position for both new blocks + (setq newBlockYPos newBlockY) + + ;; Insert first "new block" + (command "_-INSERT" "new block" "0,0,0" 0.5909 0.5909 0.5909 0) + (setq newBlk1 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation newBlk1 0.0) + (vla-move newBlk1 (vlax-3d-point '(0 0 0)) (vlax-3d-point (list newBlock1X newBlockYPos 0.0))) + + ;; Insert second "new block" mirrored on X scale + (command "_-INSERT" "new block" "0,0,0" -0.5909 0.5909 0.5909 0) + (setq newBlk2 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation newBlk2 0.0) + (vla-move newBlk2 (vlax-3d-point '(0 0 0)) (vlax-3d-point (list newBlock2X newBlockYPos 0.0))) + + ;; === Collect connector info === + (setq connectorData '()) + (setq i 0) + (while (< i numBlocks) + (setq row (/ i cols)) + (setq col (rem i cols)) + (prompt (strcat "numBlocks: " (itoa numBlocks))) + (prompt (strcat "cols: " (itoa cols))) + (if (= (rem row 2) 1) + (setq col (- cols 1 col)) + ) + + (setq x (+ xStart (* col step) (* col extraColGap))) + (setq y (- yStart (* row step))) + + (setq x1 (+ x 3.99)) + (setq x2 (+ x 4.155)) + (setq yLine (- y 3.446)) + + ;; Debug: print each block being added + (prompt (strcat "Adding block " (itoa i) ": Row " (itoa row) " Col " (itoa col))) + + (setq connectorData (append connectorData (list (list row col x1 x2 yLine)))) + (setq i (1+ i)) + ) + (prompt (strcat "Total connectorData entries: " (itoa (length connectorData)))) + + ;; === Draw horizontal cables === + (drawZigzagCables connectorData targetPt centerOffset numBlocks) + + ;; Insert "CONDUCTOR" block at center point + (setq centerPt (list 40.1 1.1 0.0)) ; Adjust this if needed + + (entmake + (list + (cons 0 "INSERT") + (cons 2 "CONDUCTOR") ; Block name + (cons 8 "0") ; Layer + (cons 10 centerPt) ; Insertion point + (cons 41 1.0) ; X scale + (cons 42 1.0) ; Y scale + (cons 43 1.0) ; Z scale + (cons 50 0.0) ; Rotation + ) + ) + + (princ (strcat "\nPlaced " (itoa numBlocks) " UPS blocks with dynamic spacing.")) + (princ) +) diff --git a/network.lsp b/network.lsp new file mode 100644 index 0000000..d7f25b5 --- /dev/null +++ b/network.lsp @@ -0,0 +1,645 @@ +(defun clearDrawing ( / ss) + ;; Select all visible, non-locked entities and delete them + (setq ss (ssget "_X" '((0 . "*")))) ; select everything + (if ss + (progn + (command "_.erase" ss "") + (princ "\nDrawing cleared.") + ) + ) +) +(defun getGap (count) + (cond + ((<= count 20) 3.95) + ((< count 25) 3.5) + ((< count 36) 2.2) + ((>= count 36) 1.3) + ) +) + +(defun getFinalOffsetY (numBlocks) + (cond + ((>= numBlocks 36) 12.0) + ((>= numBlocks 25) 11.5) + (T 10.5) + ) +) + + +;; Function to get final stop for "new block" with negative XScale +(defun getFinalStopNewBlock ( / ss i ent obj xScale insPt finalX finalY finalZ finalStop) + (vl-load-com)` + (setq ss (ssget "X" '((0 . "INSERT") (2 . "new block")))) + (if (and ss (> (sslength ss) 0)) + (progn + (setq i 0) + (while (< i (sslength ss)) + (setq ent (ssname ss i)) + (setq obj (vlax-ename->vla-object ent)) + (setq xScale (vlax-get obj 'XScaleFactor)) + (if (< xScale 0.0) + (progn + ;; Get block insertion point and calculate final stop + (setq insPt (vlax-get obj 'InsertionPoint)) + (setq finalX (+ (car insPt) 0.578)) + (setq finalY (- (cadr insPt) 0.0072)) + (setq finalZ (nth 2 insPt)) + (setq finalStop (list finalX finalY finalZ)) + + (setq i (sslength ss)) ; exit loop early + ) + ) + (setq i (1+ i)) + ) + finalStop ; return + ) + ) +) + + +(defun getFinalStopSecondNewBlock () + (vl-load-com) + (setq finalStop nil) + ;; Get selection set of all "new block" inserts + (setq ss (ssget "X" '((0 . "INSERT") (2 . "new block")))) + (if (and ss (> (sslength ss) 0)) + (progn + (setq i 0) + (while (< i (sslength ss)) + (setq ent (ssname ss i)) + (setq obj (vlax-ename->vla-object ent)) + ;; Get X scale + (setq xScale (vlax-get obj 'XScaleFactor)) + (if (> xScale 0.0) ;; positive X scale = second block + (progn + ;; Found second block + (setq insPt (vlax-get obj 'InsertionPoint)) ; list of 3 coords + (setq finalX (- (car insPt) 0.578)) + (setq finalY (- (cadr insPt) 0.0072)) + (setq finalStop (list finalX finalY (last insPt))) + (setq i (sslength ss)) ; exit loop + ) + ) + (setq i (1+ i)) + ) + ) + ) + finalStop +) + + +(defun drawHorizontalToFinalStop (startPt targetX) + (setq endPt (list targetX (cadr startPt) (caddr startPt))) + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; Layer 0 + (cons 62 3) ; Green color + (cons 10 startPt) + (cons 11 endPt) + ) + ) +) + +(defun labelLine (pt1 pt2 index moveRight? / midPt labelText offsetPt) + ;; Compose label text + (setq labelText (strcat "8911-CBL " (itoa index))) + + ;; Calculate midpoint + (setq midPt (list (/ (+ (car pt1) (car pt2)) 2.0) + (/ (+ (cadr pt1) (cadr pt2)) 2.0) + 0.0)) + + ;; Apply offset: if moveRight? then +2 in X, else -1 in X, and -0.05 in Y + (setq offsetPt (list (+ (car midPt) (if moveRight? 1.5 -1.0)) + (- (cadr midPt) 0.05) + 0.0)) + + ;; Create the text entity + (entmake + (list + (cons 0 "TEXT") + (cons 8 "0") + (cons 10 offsetPt) + (cons 40 0.3) ; text height + (cons 1 labelText) + (cons 7 "Standard") ; style + (cons 72 1) ; left justified + (cons 73 1) ; middle baseline + (cons 11 offsetPt) + ) + ) +) + + +(defun drawZigzagCables (connectorData targetPt centerOffset numBlocks / sorted i pt1 pt2 direction yDown turnPoint cur next moveTo) + (setq lineIndex 2) + (setq greenColor 3) ; green + + ;; Calculate movement offset (same as blocks) + (setq moveTo + (list + (+ (car centerOffset) (if (>= numBlocks 36) 20.0 23.0)) + (+ (cadr centerOffset) (getFinalOffsetY numBlocks)) + 0.0 + ) + ) + + ;; Sort connectorData in snake order + (setq sorted + (vl-sort connectorData + (function + (lambda (a b) + (cond + ((< (car a) (car b)) T) ; row + ((> (car a) (car b)) nil) + ;; same row, order by column - reversed for odd rows + ((= (rem (car a) 2) 1) (> (cadr a) (cadr b))) + (T (< (cadr a) (cadr b))) + ) + ) + ) + ) + ) + (setq i 0) + (while (and (< i (length sorted))) + + (setq cur (nth i sorted)) + (setq next (nth (1+ i) sorted)) + (setq isOddRow (= (rem (car cur) 2) 1)) + + ;; Check if current block is the last in its row + (if (or (= i (1- (length sorted))) ; last block overall + (and next (/= (car cur) (car next)))) ; or next block is in different row + (progn + ;; Get start point: x2 for even row, x1 for odd row + (setq pt1 (mapcar '+ (list (if isOddRow (nth 2 cur) (nth 3 cur)) (nth 4 cur) 0.0) moveTo)) + + ;; Step 1: short horizontal (1 unit left or right) + (setq horizOffset (if isOddRow -3.0 1.0)) + (setq pt2 (list (+ (car pt1) horizOffset) (cadr pt1) 0.0)) + (setq shouldLabel T) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt1) (cons 11 pt2))) + (setq shouldMoveRight (and (not isOddRow) ; even row + (or (= i (1- (length sorted))) ; last block overall + (and next (/= (car cur) (car next))))) ; or last in row + ) + + (if shouldLabel (labelLine pt1 pt2 lineIndex shouldMoveRight)) + (setq lineIndex (1+ lineIndex)) + + ;; Step 2: vertical drop if there's a next block + (if next + (progn + (setq shouldLabel nil) + (setq pt3 (list (car pt2) (+ (cadr moveTo) (nth 4 next)) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt2) (cons 11 pt3))) + + ;; Step 3: horizontal to connector of next block + (setq pt4 (list (if isOddRow (nth 2 next) (nth 3 next)) (nth 4 next) 0.0)) + + (setq pt4 (mapcar '+ pt4 moveTo)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt3) (cons 11 pt4))) + + ) + ) + ) + ) + + ;; Horizontal connection to next block in same row + (if (and next (= (car cur) (car next))) ; same row + (progn + ;; Choose correct x sides for direction + (if isOddRow + (progn + ;; right to left + (setq pt1 (mapcar '+ (list (nth 2 cur) (nth 4 cur) 0.0) moveTo)) ; x1 cur + (setq pt2 (mapcar '+ (list (nth 3 next) (nth 4 next) 0.0) moveTo)) ; x2 next + ) + (progn + ;; left to right + (setq pt1 (mapcar '+ (list (nth 3 cur) (nth 4 cur) 0.0) moveTo)) ; x2 cur + (setq pt2 (mapcar '+ (list (nth 2 next) (nth 4 next) 0.0) moveTo)) ; x1 next + ) + ) + (setq shouldLabel T) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) (cons 10 pt1) (cons 11 pt2))) + (if shouldLabel (labelLine pt1 pt2 lineIndex f)) + (setq lineIndex (1+ lineIndex)) + ) + ) + + (setq i (1+ i)) + ) + + ;; Draw extra for last block + (setq lastIndex (1- (length sorted))) + (setq lastBlock (nth lastIndex sorted)) + (setq rowNum (car lastBlock)) + (setq isEvenRow (= (rem rowNum 2) 0)) + + ;; Only draw the extra if last block didn't already connect downward + (if (= lastIndex (1- (length sorted))) ; true last block + (if isEvenRow + (progn + (setq finalStop (getFinalStopNewBlock)) + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + ;; EVEN row: x2 → right 1 → down 1 + (setq pt1 (mapcar '+ (list (nth 3 lastBlock) (nth 4 lastBlock) 0.0) moveTo)) ; x2 + (setq pt2 (list (+ (car pt1) 1.0) (cadr pt1) 0.0)) ; right 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt1) (cons 11 pt2))) + + (setq pt3 (list (car pt2) (- (cadr pt2) 1.0) 0.0)) ; down 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt2) (cons 11 pt3))) + + ;; Step 3: go left to near finalStop.x + (setq xTarget (+ (car finalStop) 1.0)) + (setq pt4 (list xTarget (cadr pt3) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt3) (cons 11 pt4))) + + ;; Step 4: vertical to finalStop.y + (setq pt5 (list xTarget (cadr finalStop) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt4) (cons 11 pt5))) + + ;; Step 5: final horizontal to exact finalStop.x + (setq pt6 (list (car finalStop) (cadr finalStop) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt5) (cons 11 pt6))) + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) + ) + (progn + (setq finalStop (getFinalStopNewBlock)) + + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + ;; Get x1 of last block + movement + (setq pt1 (mapcar '+ (list (nth 2 lastBlock) (nth 4 lastBlock) 0.0) moveTo)) + + ;; Calculate X target (1 unit before finalStop X) + (setq xTarget (+ (car finalStop) 1.0)) + + ;; Horizontal point (end of first line) + (setq horizPt (list xTarget (cadr pt1) 0.0)) + + ;; Vertical line end + (setq vertPt (list xTarget (cadr finalStop) 0.0)) + + ;; Draw horizontal + (drawHorizontalToFinalStop pt1 xTarget) + + ;; Draw vertical + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 horizPt) + (cons 11 vertPt))) + ;; Final horizontal: to reach exact finalStop X + (setq finalPt (list (car finalStop) (cadr finalStop) 0.0)) + + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 vertPt) + (cons 11 finalPt))) + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) + ) + ) + ) + + ;; Draw extra line for first block (x1 → left until aligned with final route) + (setq finalStop (getFinalStopNewBlock)) + (if finalStop + (progn + ;; Print finalStop for debug + (prompt (strcat "\nFinal stop X: " (rtos (car finalStop) 2 4) + ", Y: " (rtos (cadr finalStop) 2 4) + ", Z: " (rtos (caddr finalStop) 2 4))) + + (setq firstBlock (car sorted)) + (setq pt1 (mapcar '+ (list (nth 2 firstBlock) (nth 4 firstBlock) 0.0) moveTo)) ; x1 + (setq targetX (+ (car finalStop) 1.0)) ; align with the rest + (setq pt2 (list targetX (cadr pt1) 0.0)) ; same Y, just X target + + ;; Draw the horizontal line + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt1) (cons 11 pt2))) + (setq pt3 (list (car pt2) (+ (cadr finalStop) 2.0) 0.0)) + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt2) (cons 11 pt3))) + + ;; Draw line label + (labelLine pt1 pt2 1 f)\ + + ;; Now get second final stop and add horizontal line from pt3 to second final stop X + 1 + (setq finalStop2 (getFinalStopSecondNewBlock)) + (if finalStop2 + (progn + ;; Print debug info for second stop + (prompt (strcat "\nSecond Final stop X: " (rtos (car finalStop2) 2 4) + ", Y: " (rtos (cadr finalStop2) 2 4) + ", Z: " (rtos (caddr finalStop2) 2 4))) + + ;; Target point for second horizontal line (to second final stop X + 1, same Y as pt3) + (setq pt4 (list (- (car finalStop2) 1.0) (cadr pt3) 0.0)) + + ;; Draw horizontal line to second final stop X + 1 + (entmake (list (cons 0 "LINE") (cons 8 "0") (cons 62 greenColor) + (cons 10 pt3) (cons 11 pt4))) + + ;; Draw vertical line down from pt4 to finalStop2 Y (keeping pt4.X) + (setq vertPt (list (car pt4) (cadr finalStop2) 0.0)) + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 pt4) + (cons 11 vertPt))) + + ;; Draw horizontal line from vertPt to finalStop2 (full X and Y) + (entmake (list + (cons 0 "LINE") + (cons 8 "0") + (cons 62 greenColor) + (cons 10 vertPt) + (cons 11 finalStop2))) + ) + (prompt "\nError: finalStop2 is NIL! 'new block' with positive XScale not found.") + ) + + ) + (prompt "\nError: finalStop is NIL! 'new block' with negative XScale not found.") + ) +) + +(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 c:Init_Network ( / numBlocks cols rows i row col x y + spacing gap baseGap totalWidth totalHeight + xStart yStart basePt targetPt ent blkRef + attList centerOffset) + + ;; Clear everything first + (clearDrawing) + + + (setq deviceList (readDeviceListFromFile)) + (if (not deviceList) + (progn + (princ "\nError: Device list file not found or empty.") + (exit) + ) + ) + + (setq numBlocks (length deviceList)) + + ; Grid dimensions + (setq rows (fix (sqrt numBlocks))) ; fewer rows + (setq cols (fix (/ (+ numBlocks rows -1) rows))) ; more columns + + (if (or (= numBlocks 25) (= numBlocks 36)) + (setq cols (1+ cols)) + ) + ;; Dynamic gap + (setq gap (getGap numBlocks)) + (setq spacing 3.0) + (setq step (+ spacing gap)) ; actual distance between blocks + + ;; Insert background grid block + (setvar "CLAYER" "AS_GRID") + (setq basePt "0,0,0") + (command "_-INSERT" "A$Cae272396" basePt 1 1 0) + + ;; UPS block layer and setup + (setvar "CLAYER" "AS_ENET CABLE") + (setvar "ATTDIA" 0) + (setvar "ATTREQ" 0) + + ;; Calculate offsets for centering + (setq totalWidth (* cols step)) + (setq totalHeight (* rows step)) + (setq xStart (- (/ totalWidth 2.0))) + (setq yStart (/ totalHeight 2.0)) + (setq centerOffset (list (/ spacing 2.0) (/ spacing 2.0) 0.0)) + + (setq extraColGap (if (>= numBlocks 36) 0.75 0.0)) + (setq i 0) + ;; Place UPS blocks + (while (< i numBlocks) + (setq row (/ i cols)) + (setq col (rem i cols)) + + ;; Snake pattern + (if (= (rem row 2) 1) + (setq col (- cols 1 col)) + ) + + ;; Grid point + (setq x (+ xStart (* col step) (* col extraColGap))) + (setq y (- yStart (* row step))) + (setq targetPt (list x y 0)) + + ;; Insert block at 0,0 and scale + (command "_-INSERT" "UPS_DPM_BRACKET" "0,0,0" 0.2212 0.2212 0.2212 0) + (setq ent (entlast)) + (if ent + (setq blkRef (vlax-ename->vla-object ent)) + (princ "\nError: Block insert failed.") + ) + + ;; Move to adjusted centered position + (setq moveTo + (mapcar '+ targetPt + (list + (+ (car centerOffset) (if (>= numBlocks 36) 20.0 23.0)) + (+ (cadr centerOffset) (getFinalOffsetY numBlocks)) + 0.0 + ) + ) + ) + (vla-move blkRef (vlax-3d-point '(0 0 0)) (vlax-3d-point moveTo)) + + ;; Get device name for current block + (setq deviceName (nth i deviceList)) + + ;; Set TAG2 attribute to zigzag index + (setq attList (vlax-invoke blkRef 'GetAttributes)) + (foreach att attList + (if (= (strcase (vla-get-TagString att)) "TAG2") + (vla-put-TextString att deviceName) + ) + ) + + ;; === Draw connector lines === + (setq start1 (list (+ (car moveTo) 3.99) (- (cadr moveTo) 3.196) 0.0)) + (setq end1 (list (car start1) (- (cadr start1) 0.25) 0.0)) + + (setq start2 (list (+ (car moveTo) 4.155) (cadr start1) 0.0)) + (setq end2 (list (car start2) (- (cadr start2) 0.25) 0.0)) + + (setvar "CLAYER" "0") ; or create a special cable layer if needed + (setq greenColor 3) ; AutoCAD color index for green + + ;; Draw first line + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; layer + (cons 62 greenColor) ; color + (cons 10 start1) + (cons 11 end1) + ) + ) + + ;; Draw second line + (entmake + (list + (cons 0 "LINE") + (cons 8 "0") ; layer + (cons 62 greenColor) + (cons 10 start2) + (cons 11 end2) + ) + ) + + (setq i (1+ i)) + ) + + ;; Layer and attribute prompt settings + (setvar "CLAYER" "PSYMS") + (setvar "ATTDIA" 0) + (setvar "ATTREQ" 0) + + ;; Target positions + (setq ptTop (list 1.0 16.0 0.0)) ; Top block + (setq ptBot (list 1.86 10.0 0.0)) ; Bottom block + + ;; If block count is 16 or less, shift X positions by +4.0 + (cond + ((<= numBlocks 16) + (setq ptTop (list (+ (car ptTop) 4.0) (cadr ptTop) (caddr ptTop))) + (setq ptBot (list (+ (car ptBot) 4.0) (cadr ptBot) (caddr ptBot)))) + + ((and (>= numBlocks 25) (< numBlocks 31)) + (setq ptTop (list (+ (car ptTop) 3.0) (cadr ptTop) (caddr ptTop))) + (setq ptBot (list (+ (car ptBot) 3.0) (cadr ptBot) (caddr ptBot)))) + ) + + ;; Insert top block (1783-BMS20CGL) + (command "_-INSERT" "1783-BMS20CGL" "0,0,0" 0.75 0.75 0.75 0) + (setq blk1 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation blk1 0.0) ; <- Force zero rotation + (vla-move blk1 (vlax-3d-point '(0 0 0)) (vlax-3d-point ptTop)) + + ;; Insert bottom block (PATCH_PANEL) + (command "_-INSERT" "PATCH_PANEL" "0,0,0" 0.75 0.75 0.75 0) + (setq blk2 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation blk2 0.0) ; <- Force zero rotation + (vla-move blk2 (vlax-3d-point '(0 0 0)) (vlax-3d-point ptBot)) + + ;; Calculate new Y position based on second block (PATCH_PANEL) + (setq newBlockY (+ (cadr ptBot) 1.3702)) + + ;; X positions relative to second block X + (setq newBlock1X (+ (car ptBot) 0.4274)) + (setq newBlock2X (+ (car ptBot) 1.5219)) + + ;; Y position for both new blocks + (setq newBlockYPos newBlockY) + + ;; Insert first "new block" + (command "_-INSERT" "new block" "0,0,0" 0.5909 0.5909 0.5909 0) + (setq newBlk1 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation newBlk1 0.0) + (vla-move newBlk1 (vlax-3d-point '(0 0 0)) (vlax-3d-point (list newBlock1X newBlockYPos 0.0))) + + ;; Insert second "new block" mirrored on X scale + (command "_-INSERT" "new block" "0,0,0" -0.5909 0.5909 0.5909 0) + (setq newBlk2 (vlax-ename->vla-object (entlast))) + (vla-put-Rotation newBlk2 0.0) + (vla-move newBlk2 (vlax-3d-point '(0 0 0)) (vlax-3d-point (list newBlock2X newBlockYPos 0.0))) + + ;; === Collect connector info === + (setq connectorData '()) + (setq i 0) + (while (< i numBlocks) + (setq row (/ i cols)) + (setq col (rem i cols)) + (prompt (strcat "numBlocks: " (itoa numBlocks))) + (prompt (strcat "cols: " (itoa cols))) + (if (= (rem row 2) 1) + (setq col (- cols 1 col)) + ) + + (setq x (+ xStart (* col step) (* col extraColGap))) + (setq y (- yStart (* row step))) + + (setq x1 (+ x 3.99)) + (setq x2 (+ x 4.155)) + (setq yLine (- y 3.446)) + + ;; Debug: print each block being added + (prompt (strcat "Adding block " (itoa i) ": Row " (itoa row) " Col " (itoa col))) + + (setq connectorData (append connectorData (list (list row col x1 x2 yLine)))) + (setq i (1+ i)) + ) + (prompt (strcat "Total connectorData entries: " (itoa (length connectorData)))) + + ;; === Draw horizontal cables === + (drawZigzagCables connectorData targetPt centerOffset numBlocks) + + ;; Insert "CONDUCTOR" block at center point + (setq centerPt (list 40.1 1.1 0.0)) ; Adjust this if needed + + (entmake + (list + (cons 0 "INSERT") + (cons 2 "CONDUCTOR") ; Block name + (cons 8 "0") ; Layer + (cons 10 centerPt) ; Insertion point + (cons 41 1.0) ; X scale + (cons 42 1.0) ; Y scale + (cons 43 1.0) ; Z scale + (cons 50 0.0) ; Rotation + ) + ) + + (princ (strcat "\nPlaced " (itoa numBlocks) " UPS blocks with dynamic spacing.")) + (princ) +) diff --git a/read-csv.lsp b/read-csv.lsp new file mode 100644 index 0000000..36f9cfa --- /dev/null +++ b/read-csv.lsp @@ -0,0 +1,175 @@ +(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