LCI/autocad
10
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

starting point of the autocad scripts

Browse Source
This commit is contained in:
Salijoghli 2025-07-23 20:57:16 +04:00
commit 666728a819
10 changed files with 3572 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
block-dimensions.lsp Normal file
View File

@ -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)
)

440
devlay-v2.lsp Normal file
View File

@ -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)
)

391
devlay.lsp Normal file
View File

@ -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)
)

305
layout-base-v2.lsp Normal file
View File

@ -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)
)

231
layout-base.lsp Normal file
View File

@ -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)
)

371
network-diagram-v2.lsp Normal file
View File

@ -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)
)

331
network-diagram.lsp Normal file
View File

@ -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)
)

645
network-v2.lsp Normal file
View File

@ -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)
)

645
network.lsp Normal file
View File

@ -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)
)

175
read-csv.lsp Normal file
View File

@ -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)
)