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

modifications in some codes. feat: made new lsp that will take the data from the sorter file and do all the stuff in the autocad

Browse Source
This commit is contained in:
Salijoghli 2025-10-06 11:34:28 +04:00
parent 22c335e06e
commit c042a34879
9 changed files with 2295 additions and 638 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

934
BNA8/automation-master.lsp Normal file
View File

@ -0,0 +1,934 @@
;;; automation-master-sequential.lsp
;;; Sequential CSV reading by TAGNAME, place blocks and populate attributes immediately.
;;; devlay_update section starts here
(defun disable-snap-states ()
"Turn OFF Osnap, Ortho, and Object Snap Tracking"
;; Turn OFF Osnap using system variable
(setvar "OSMODE" 0)
(princ "\n<Osnap off>")
;; Turn OFF Ortho
(command "ORTHO" "OFF")
(princ "\n<Ortho off>")
;; Turn OFF Object Snap Tracking using system variable
(setvar "AUTOSNAP" (boole 6 (getvar "AUTOSNAP") 2)) ; Turn off tracking bit
(princ "\n<Object Snap Tracking off>")
(princ "\nSnap states disabled...")
)
(defun enable-snap-states ()
"Turn ON Osnap, Ortho, and Object Snap Tracking"
;; Turn ON Osnap using system variable (common snap modes)
(setvar "OSMODE" 4133) ; Common snap modes: endpoint, midpoint, center, intersection, etc.
(princ "\n<Osnap on>")
;; Turn ON Ortho
(command "ORTHO" "ON")
(princ "\n<Ortho on>")
;; Turn ON Object Snap Tracking using system variable
(setvar "AUTOSNAP" (boole 7 (getvar "AUTOSNAP") 2)) ; Turn on tracking bit
(princ "\n<Object Snap Tracking on>")
(princ "\nSnap states enabled...")
)
;; Function to get attribute value by tag from a list of attributes
(defun getAttVal (attList tag)
(setq tag (strcase tag))
(setq a (vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
))
(if a
(strcase (vl-string-trim " " (vla-get-textstring a)))
""
)
)
;; Function to get attribute object by tag from a list of attributes
(defun getAttObj (attList tag)
(setq tag (strcase tag))
(vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
)
)
;; Function to move TAG1 attribute up and left by 0.5 units
(defun moveTag1UpLeft (block / att basePt newPt)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) "TAG1")
(progn
(setq basePt (vlax-get att 'InsertionPoint))
(setq newPt (list (+ (car basePt) 0.5) (+ (cadr basePt) 0.5) (caddr basePt)))
(vlax-put att 'InsertionPoint newPt)
(if (vlax-property-available-p att 'AlignmentPoint)
(vlax-put att 'AlignmentPoint newPt)
)
(if (vlax-property-available-p att 'TextAlignmentPoint)
(vlax-put att 'TextAlignmentPoint newPt)
)
(vlax-put att 'Color 2)
)
)
)
)
;; Function to set attribute value in a block
(defun setBlockAttr (block tag value)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) (strcase tag))
(vla-put-textstring att value)
)
)
)
;; Function to build pairs of DESCA blocks
(defun build-pairs (maxNum)
(setq result '())
(setq n 1)
(while (<= n maxNum)
(setq a (strcat "DESCA" (if (< n 10) (strcat "0" (itoa n)) (itoa n))))
(setq next (+ n 1))
(if (<= next maxNum)
(setq b (strcat "DESCA" (if (< next 10) (strcat "0" (itoa next)) (itoa next))))
(setq b "")
)
(setq result (append result (list (list a b))))
(setq n (+ n 2))
)
result
)
;; Function to delete existing blocks
(defun delete-existing-devlay-blocks ( / blockNames ss i ent obj)
(setq blockNames '(
"HC01_CORDSET_STR-STR_STRAIGHT"
"CORDSET_STR-STR_1DEVICE PER PORT"
"HC01_SPLITTER"
"HC01_SPLITTER(RIGHT)"
))
(foreach blkName blockNames
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 blkName))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Delete all red circles (used as error indicators)
(setq ss (ssget "_X" '((0 . "CIRCLE") (62 . 1)))) ; 62=1 → red
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Function to process each block type
(defun process-block-type (blkName maxDesca)
(setq filter (list (cons 0 "INSERT") (cons 2 blkName)))
(setq sioLikeBlocks '("PLCIO_ARMORBLOCK_SIO" "PLCIO_ARMBLOCK_FIOM" "PLCIO_ARMORBLOCK_FIOH"))
(setq mirrorThreshold (if (member blkName sioLikeBlocks) 9 7))
(setq ss (ssget "X" filter))
;; Initialize pairs of attributes for DESCA blocks
(if ss
(progn
(princ (strcat "\n[devlay_update] Found blocks named \"" blkName "\"."))
(setq pairs (build-pairs maxDesca))
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq attList (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes))
(foreach pair pairs
(setq val1 (getAttVal attList (car pair)))
(setq val2 (getAttVal attList (cadr pair)))
;; Treat "SPARE" as empty
(if (= val1 "SPARE") (setq val1 ""))
(if (= val2 "SPARE") (setq val2 ""))
;; Case 1: both have values (pairs)
(if (and (/= val1 "") (/= val2 ""))
(progn
(setq att1 (getAttObj attList (car pair)))
(setq att2 (getAttObj attList (cadr pair)))
(if (and att1 att2)
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt1 (vlax-get att1 'InsertionPoint))
(setq pt2 (vlax-get att2 'InsertionPoint))
(setq tagNum (atoi (substr (car pair) 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7))
(setq shiftRightX (if (= tagNum 7) 2.0 0.0))
(setq x1 (+ (car pt1) xOffset shiftRightX))
(setq xCordset (if (>= tagNum mirrorThreshold) (- x1 0.13) x1))
(setq y1 (+ (cadr pt1) 0.1))
(setq newPt1 (list xCordset y1 0.0))
;; NEW: Check if block is FIO or FIOH
(if (or (= blkName "PLCIO_ARMBLOCK_FIOM") (= blkName "PLCIO_ARMORBLOCK_FIOH"))
(progn
(setq newPt1Adjusted
(if (>= tagNum mirrorThreshold)
;; Right side
(list (- (car newPt1) 1.4571) (- (cadr newPt1) 0.6375) (caddr newPt1))
;; Left side
(list (+ (car newPt1) 0.7) (- (cadr newPt1) 0.6375) (caddr newPt1))
)
)
;; Additional shift if TAG7 or TAG8
(if (or (= tagNum 7) (= tagNum 8))
(setq newPt1Adjusted
(list
(- (car newPt1Adjusted) 2.0)
(cadr newPt1Adjusted)
(caddr newPt1Adjusted)
)
)
)
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1Adjusted 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setq tagnumStr (substr (car pair) 6))
(setq tagnum (atoi tagnumStr))
(setq taga1
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
(progn
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
;; Remove last two chars from TAGA value
(setq val (getAttVal attList (strcat "TAGA" evenTagStr)))
(substr val 1 (- (strlen val) 2))
)
(getAttVal attList (strcat "TAGA" tagnumStr))
)
)
(setBlockAttr newBlock1 "TAG1" taga1)
)
(progn
;; EXISTING CODE for all other blocks
(if (and val1 val2
(or (and (vl-string-search "SEL" val1) (vl-string-search "SEL" val2))
(and (vl-string-search "DPM" val1) (vl-string-search "DPM" val2))
;; NEW: Additional conditions for single straight block
(and (vl-string-search "VFD" val1) (vl-string-search "STO" val1)
(vl-string-search "VFD" val2) (vl-string-search "STO" val2))
(and (vl-string-search "JR" val1) (vl-string-search "_PB" val1) (vl-string-search "JR" val2) (vl-string-search "_PB_LT" val2))
(and (vl-string-search "EPC" val1) (vl-string-search "EPC" val2))
(and (vl-string-search "SSP" val1) (vl-string-search "SSP" val2))))
(progn
;; Insert single straight block
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock (vlax-ename->vla-object (entlast)))
;; Set TAG1 attribute
(setq tagnumStr (substr (car pair) 6))
(setq taga (getAttVal attList (strcat "TAGA" tagnumStr)))
(setBlockAttr newBlock "TAG1" taga)
;; Mirror if needed
(setq tagNum (atoi tagnumStr))
(setq finalBlock newBlock) ; assume no mirror
(if (>= tagNum mirrorThreshold)
(progn
(command "_MIRROR" (vlax-vla-object->ename newBlock) "" newPt1 (list (car newPt1) (+ (cadr newPt1) 0.1)) "N")
(entdel (vlax-vla-object->ename newBlock))
(setq finalBlock (vlax-ename->vla-object (entlast))) ; update to mirrored block
)
)
;; === NEW: Move single straight block left/right depending on side ===
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(and (member blkName sioLikeBlocks) (>= tagNum 8)))
;; Right side: move left 1 unit
(progn
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (- (car basePt) 0.5) (cadr basePt) (caddr basePt)))
(vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
;; Left side: move right 0.5 unit
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (<= tagNum 7))
(and (member blkName sioLikeBlocks) (< tagNum 8)))
(progn
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) 1.0) (cadr basePt) (caddr basePt)))
(vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
)
;; === END NEW ===
;; Move all SEL blocks 1 unit down. Also move 4 units left for DESCA07 - 09 (SIO)
(setq shiftX (if (>= tagNum mirrorThreshold) -3 0))
(setq shiftY -0.5)
;; Get current position of block (not assuming newPt1 anymore)
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) shiftX)
(+ (cadr basePt) shiftY)
(caddr basePt)))
(vla-move finalBlock
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
)
(progn
;; ELSE part: Insert two straight blocks + splitter
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setq taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
(setBlockAttr newBlock1 "TAG1" taga1)
(setq y2 (+ (cadr pt2) 0.1))
(setq newPt2 (list xCordset y2 0.0))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
(setq newBlock2 (vlax-ename->vla-object (entlast)))
(setq taga2 (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
(setBlockAttr newBlock2 "TAG1" taga2)
(setq x3 (+ x1 (if (< tagNum mirrorThreshold) 1.25 -1.25)))
(setq y3 (/ (+ y1 y2) 2.0))
(setq newPt3 (list x3 y3 0.0))
(if (< tagNum mirrorThreshold)
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
(progn
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
(setq splitterEnt (vlax-ename->vla-object (entlast)))
(setq newPos (list (- x3 2.2) (+ y3 0.0) 0.0))
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
)
)
;; Extra adjustment for Powerflex DESCA07+ (move all 3 blocks left, splitter up)
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(progn
(setq newX1 (- (car newPt1) 1.8))
(setq newX2 (- (car newPt2) 1.8))
(setq newX3 (- (car newPt3) 1.8))
(setq newY3 (+ (cadr newPt3) 0.0)) ; splitter up
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 (cadr newPt1) (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 (cadr newPt2) (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3)))
)
)
;; If this is the second block type, shift blocks closer together
(if (member blkName sioLikeBlocks)
(progn
(setq moveVecX
(if (or (= tagNum 7) (= tagNum 8))
-1.5
(if (< tagNum mirrorThreshold) 0.5 -1.4)
)
) ; inward move
;; Additional right shift of 0.5 for SIO-like blocks on right side (tagNum >= 9)
(setq rightShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.5 0.0))
;; Additional downward shift of 0.5 for SIO-like blocks on right side (tagNum >= 9)
(setq downShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.1 0.0))
(setq newX1 (+ (car newPt1) moveVecX rightShift))
(setq newX2 (+ (car newPt2) moveVecX rightShift))
(setq newX3
(if (or (= tagNum 7) (= tagNum 8))
(+ (car newPt3) -1.5 rightShift)
(+ (car newPt3) moveVecX rightShift)
)
)
(setq newY1 (- (cadr newPt1) downShift))
(setq newY2 (- (cadr newPt2) downShift))
(setq newY3
(if (or (= tagNum 7) (= tagNum 8))
(+ (cadr newPt3) -0.015 downShift)
(- (cadr newPt3) downShift)
)
)
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 newY1 (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 newY2 (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3)))
)
)
)
)
)
)
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; Case 2: single value only
(if (and (/= val1 "") (= val2 ""))
(progn
(setq attTag (if (/= val1 "") (car pair) (cadr pair)))
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt (vlax-get attObj 'InsertionPoint))
(setq tagNum (atoi (substr attTag 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 5.5 -5.0))
(setq x (+ (car pt) xOffset))
(setq y (- (cadr pt) 0.5))
(setq xAdjust
(if (and (member blkName sioLikeBlocks) (>= tagNum 9))
0.0 ; right side → move slightly left
(if (member blkName sioLikeBlocks)
0.7 ; left side → move slightly right
0.0 ; other blocks → no change
)
)
)
;; Extra right shift for Powerflex DESCA07+
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(setq xAdjust (+ xAdjust 1.0))
)
(setq insPt (list (+ x xAdjust) y 0.0))
;; For PLCIO_ARMORPOWERFLEX, special DESCA11 block placement
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(setq insPt (list (+ x 2.0) (+ y 0.5) 0.0))
)
;; Insert proper block based on conditions
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0) ; old block special single
(command "_-INSERT" "CORDSET_STR-STR_1DEVICE PER PORT" insPt 1 1 0) ; other singles
)
(setq newEnt (entlast))
(setq newBlock (vlax-ename->vla-object newEnt))
;; FIX: Keep string version for TAGA, convert to int for comparisons
(setq tagnumStr (substr attTag 6))
(setq tagnum (atoi tagnumStr))
(setq taga
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
(progn
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
(getAttVal attList (strcat "TAGA" evenTagStr))
)
(getAttVal attList (strcat "TAGA" tagnumStr))
)
)
(setBlockAttr newBlock "TAG1" taga)
;; For non-special single blocks, move attribute
(if (not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11)))
(moveTag1UpLeft newBlock)
)
; Mirror blocks for DESCA07 and above except special single DESCA11
; FIX: Use tagnum (integer) instead of comparing with string
(if (and (>= tagnum mirrorThreshold)
(not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagnum 11))))
(progn
(command "_MIRROR" newEnt "" insPt (list (car insPt) (+ (cadr insPt) 0.1)) "N")
(entdel newEnt)
(setq newBlock (vlax-ename->vla-object (entlast)))
)
)
;; === NEW: Move single straight block left/right depending on side ===
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagnum 7))
(and (member blkName sioLikeBlocks) (>= tagnum 8) (= tagnum 15)))
;; Right side: move left 1 unit (only for last DESCA in SIO-like blocks)
(progn
(setq basePt (vlax-get newBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) 0.5) (cadr basePt) (caddr basePt)))
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === NEW: Move SIO-like single blocks on left side to the left ===
(if (and (member blkName sioLikeBlocks) (< tagnum 8))
;; Left side SIO-like blocks: move left 0.5 unit
(progn
(setq basePt (vlax-get newBlock 'InsertionPoint))
(setq targetPt (list (- (car basePt) 0.7) (cadr basePt) (caddr basePt)))
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === END NEW ===
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; ELSE branch: val1 is empty, val2 has value → print warning
(if (and (= val1 "") (/= val2 ""))
(progn
(setq attTag (car pair)) ; Always expect the first attribute to be filled
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
;; Insertion point of the attribute itself
(setq insPt (vlax-get attObj 'InsertionPoint))
;; Draw red circle to mark the issue
(entmakex
(list
(cons 0 "CIRCLE")
(cons 8 "0") ; Layer
(cons 10 insPt) ; Center at attribute
(cons 40 1.3) ; Radius
(cons 62 1) ; Red color
)
)
)
)
)
)
)
(setq i (1+ i))
)
)
(princ (strcat "\n[devlay_update] No blocks named \"" blkName "\" found."))
)
)
(defun devlay_update ()
(delete-existing-devlay-blocks)
(process-block-type "PLCIO_ARMORPOWERFLEX" 11)
(process-block-type "PLCIO_ARMORBLOCK_SIO" 16)
(process-block-type "PLCIO_ARMBLOCK_FIOM" 16)
(process-block-type "PLCIO_ARMORBLOCK_FIOH" 16)
(princ)
)
;;; devlay_update section ends here
;;; -----------------------
;;; Utilities
;;; -----------------------
(defun trim (s) (vl-string-trim " \t\n\r" s) )
(defun csv-first-field (line / pos)
(if (null line) ""
(progn
(setq pos (vl-string-search "," line))
(if pos (trim (substr line 1 pos)) (trim line))
)
)
)
(defun split-csv-line (line / start pos cols len cell)
(setq cols '())
(setq start 0)
(setq len (strlen line))
(while (and (< start len) (setq pos (vl-string-search "," line start)))
(setq cell (trim (substr line (+ start 1) (- pos start))))
;; remove surrounding double quotes if present
(if (and (> (strlen cell) 1)
(= (substr cell 1 1) "\"")
(= (substr cell (strlen cell) 1) "\""))
(setq cell (substr cell 2 (- (strlen cell) 2))))
(setq cols (append cols (list cell)))
;; move start to the character after the comma (pos is 0-based index of comma)
(setq start (+ pos 1))
)
;; handle last column: if start == len then last column is empty string
(if (<= start len)
(progn
(if (< start len)
(setq cell (trim (substr line (+ start 1) (- len start))))
(setq cell "") ; trailing comma -> empty last column
)
;; remove surrounding quotes on last cell too
(if (and (> (strlen cell) 1)
(= (substr cell 1 1) "\"")
(= (substr cell (strlen cell) 1) "\""))
(setq cell (substr cell 2 (- (strlen cell) 2))))
(setq cols (append cols (list cell)))
)
)
cols
)
(defun my-subseq (lst start end / result i len)
(setq result '())
(setq len (length lst))
(setq end (min end len))
(setq i start)
(while (< i end)
(setq result (append result (list (nth i lst))))
(setq i (1+ i))
)
result
)
;;; -----------------------
;;; Block helpers
;;; -----------------------
(defun insertBlockAt (blockName basePt targetPt)
(command "_.-INSERT" blockName basePt 1 1 0)
(setq ent (entlast))
(if ent
(progn
(vla-move (vlax-ename->vla-object ent)
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
)
)
ent
)
(defun setDESCAtoSpare (block)
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "DESCA*") (vla-put-textstring att "SPARE"))
)
)
;;; -----------------------
;;; Attribute population (dynamic rows)
;;; csvData: list of rows belonging to this block (each row = list of columns)
;;; columns: 0=TAGNAME,1=ADDR,2=TERM,3=TERMDESC,4=DESCA,5=DESCB
;;; -----------------------
(defun populateBlockAttributes (block csvData / att tag1Attr attr attrName row i rowIndex numRows fmtIdx fldVal targetTag firstTag)
(setq att (vlax-invoke block 'GetAttributes))
(if (not att)
(progn (princ "\nWarning: block has no attributes.") )
(progn
;; TAG1 or TAG1F using first row's TAGNAME
(setq firstTag (if (and csvData (> (length csvData) 0)) (nth 0 (nth 0 csvData)) ""))
(setq tag1Attr (vl-some
(function (lambda (a)
(setq attrName (strcase (vla-get-tagstring a)))
(if (equal attrName "TAG1") a nil)))
att))
(if tag1Attr
(vla-put-textstring tag1Attr (strcase firstTag))
(progn
(setq tag1Attr (vl-some
(function (lambda (a)
(setq attrName (strcase (vla-get-tagstring a)))
(if (equal attrName "TAG1F") a nil)))
att))
(if tag1Attr (vla-put-textstring tag1Attr (strcase firstTag)))
)
)
;; dynamic number of rows for indexing
(setq numRows (length csvData))
(setq i 0)
(while (< i numRows)
(setq row (nth i csvData))
(setq rowIndex (1+ i))
;; format index as 01,02...09,10...
(setq fmtIdx (if (< rowIndex 10) (strcat "0" (itoa rowIndex)) (itoa rowIndex)))
;; ADDR -> TAGA##
(setq targetTag (strcat "TAGA" fmtIdx))
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
(setq fldVal (if (and row (>= (length row) 2)) (nth 1 row) ""))
(if attr (vla-put-textstring attr fldVal))
;; TERM -> TERM##
(setq targetTag (strcat "TERM" fmtIdx))
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
(setq fldVal (if (and row (>= (length row) 3)) (nth 2 row) ""))
(if attr (vla-put-textstring attr fldVal))
;; DESCA -> DESCA##
(setq targetTag (strcat "DESCA" fmtIdx))
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
(setq fldVal (if (and row (>= (length row) 5)) (nth 4 row) ""))
(if attr (vla-put-textstring attr fldVal))
;; DESCB -> DESCB##
(setq targetTag (strcat "DESCB" fmtIdx))
(setq attr (vl-some (function (lambda (a) (if (equal (strcase (vla-get-tagstring a)) targetTag) a nil))) att))
(setq fldVal (if (and row (>= (length row) 6)) (nth 5 row) ""))
(if attr (vla-put-textstring attr fldVal))
(setq i (1+ i))
)
;; update block to refresh attributes
(vlax-invoke (vlax-ename->vla-object (entlast)) 'Update)
)
)
)
;;; -----------------------
;;; Device placement — sequential TAGNAME grouping approach
;;; layoutDevices not precomputed: we use csvRows + csvIndex and group rows by TAGNAME
;;; -----------------------
(defun placeSequentialDevices (layoutStartX posIndex deviceTag blockRows / blk ent vlaEnt pos)
;; deviceTag = group TAGNAME (string)
;; blockRows = list of rows belonging to this block
;; choose block type by searching TAGNAME (case-insensitive)
(setq devUpper (strcase deviceTag))
(setq blk
(cond
((vl-string-search "APF" devUpper) "PLCIO_ARMORPOWERFLEX")
((vl-string-search "SIO" devUpper) "PLCIO_ARMORBLOCK_SIO")
((vl-string-search "FIOH" devUpper) "PLCIO_ARMORBLOCK_FIOH")
((vl-string-search "FIO" devUpper) "PLCIO_ARMBLOCK_FIOM")
(T nil)
)
)
;; positions arrays
(setq positions (list
(list 9.63 9.5 0.0)
(list 9.63 -1.5 0.0)
(list 28.88 9.5 0.0)
(list 28.88 -1.5 0.0)))
(setq positionsB (list
(list 9.6 9.5 0.0)
(list 9.6 -1.5 0.0)
(list 28.9666 9.5 0.0)
(list 28.9666 -1.5 0.0)))
(if blk
(progn
;; compute insertion pos using posIndex and layoutStartX
(setq pos (if (or (vl-string-search "FIOH" devUpper) (vl-string-search "FIO" devUpper))
(mapcar '+ (nth posIndex positionsB) (list layoutStartX 0 0))
(mapcar '+ (nth posIndex positions) (list layoutStartX 0 0))))
;; insert and fill
(insertBlockAt blk '(0 0 0) pos)
(setq ent (entlast))
(if ent
(progn
(setq vlaEnt (vlax-ename->vla-object ent))
(setDESCAtoSpare vlaEnt)
(populateBlockAttributes vlaEnt blockRows)
)
(princ (strcat "\nFailed to insert block: " blk))
)
)
(princ (strcat "\nWarning: could not determine block type for: " deviceTag))
)
)
;;; -----------------------
;;; 20_zone helpers (unchanged logic)
;;; -----------------------
(defun labelBlockLines (block startNum)
(setq counter 0)
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "LINE*")
(progn
(setq labelNum (+ startNum counter))
(setq labelStr (if (< labelNum 10) (strcat "0" (itoa labelNum)) (itoa labelNum)))
(setq basePt (vlax-get att 'InsertionPoint))
(setq blockPos (vlax-get block 'InsertionPoint))
(setq labelPt (list (+ (car blockPos) 0.12) (- (cadr basePt) 0.053) (caddr basePt)))
(entmakex (list (cons 0 "TEXT") (cons 8 "0") (cons 7 "WD") (cons 62 7)
(cons 10 labelPt) (cons 11 labelPt) (cons 40 0.13) (cons 72 1)
(cons 73 1) (cons 1 labelStr) (cons 50 0.0)))
(setq counter (1+ counter))
)
)
)
)
(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue sideOffset / blockObj attrList attr attrName idx newValue formattedValue)
(setq blockObj (vlax-ename->vla-object blockEnt))
(setq attrList (vlax-invoke blockObj 'GetAttributes))
(foreach attr attrList
(setq attrName (vlax-get-property attr 'TagString))
(if (and (>= (strlen attrName) 5)
(= (substr attrName 1 4) "LINE")
(>= (atoi (substr attrName 5)) 1)
(<= (atoi (substr attrName 5)) 20))
(progn
(setq idx (atoi (substr attrName 5)))
(setq newValue (+ (atoi startValue) layoutIndex (- idx 1) sideOffset))
(setq formattedValue (strcat (itoa newValue) "."))
(vlax-put-property attr 'TextString formattedValue)
(vlax-invoke attr 'Update)
)
)
)
(vlax-invoke blockObj 'Update)
)
;;; -----------------------
;;; MAIN FUNCTION
;;; -----------------------
(defun c:init_layout ( / csvFile csvRows file line cols headerSkipped csvIndex totalRows layoutNum layoutStartX posIndex blocksLeft numBlocksInLayout layoutDevices firstTag currentTag blockRows)
(disable-snap-states)
;; select CSV
(setq csvFile (getfiled "Select source CSV file" "" "csv" 0))
(if (not csvFile) (progn (princ "\nNo CSV file selected. Aborting.") (princ))
(progn
;; read CSV lines into list, skipping header (first non-empty line)
(setq csvRows '())
(setq file (open csvFile "r"))
(setq headerSkipped nil)
(while (setq line (read-line file))
(if (not (= line ""))
(progn
(if headerSkipped
(progn
(setq cols (split-csv-line line))
(setq csvRows (append csvRows (list cols)))
)
(setq headerSkipped T) ; first non-empty row considered header and skipped
)
)
)
)
(close file)
;; prepare drawing
(setq oldAttReq (getvar "ATTREQ")) (setvar "ATTREQ" 0)
(setq offsetX 38.5)
;; user start index (keeps old behavior for 20_zone)
(setq startIndex (getstring "\nEnter starting line index (e.g. 01600): "))
;; sequential processing
(setq csvIndex 0)
(setq totalRows (length csvRows))
(setq layoutNum 0)
(setq posIndex 0) ; position within current layout (0..3)
(while (< csvIndex totalRows)
;; if starting a new layout (posIndex == 0) draw the layout box and 20_zone blocks
(if (= posIndex 0)
(progn
(setq layoutStartX (* layoutNum offsetX))
;; draw outer box and lines (same as before)
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0))
(command (list (+ 38.5 layoutStartX) -11.0))
(command (list (+ 38.5 layoutStartX) 11.0))
(command (list (+ 0 layoutStartX) 11.0))
(command "C")
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0) (list (+ 0 layoutStartX) 11.0) "")
(command "_.PLINE" (list (+ 38.5 layoutStartX) -11.0) (list (+ 38.5 layoutStartX) 11.0) "")
(command "_.PLINE" (list (+ 19.25 layoutStartX) -11.0) (list (+ 19.25 layoutStartX) 11.0) "")
;; Insert 20_zone left & right and label them
(setq basePt '(0 0 0))
(setq ptLeft (list (+ 0.75 layoutStartX) 9.5 0))
(setq ptRight (list (+ 20.0 layoutStartX) 9.5 0))
(setq leftEnt (insertBlockAt "20_zone" basePt ptLeft))
(if leftEnt
(progn
(setq leftBlock (vlax-ename->vla-object leftEnt))
(update20ZoneBlockAttributes leftEnt layoutNum startIndex 0)
(labelBlockLines leftBlock 1)
)
)
(setq rightEnt (insertBlockAt "20_zone" basePt ptRight))
(if rightEnt
(progn
(setq rightBlock (vlax-ename->vla-object rightEnt))
(update20ZoneBlockAttributes rightEnt layoutNum startIndex 0)
(labelBlockLines rightBlock 21)
)
)
;; layout label
(setq labelPt (list (+ layoutStartX 14.0) 16.0 0.0))
(command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ layoutNum))))
)
) ; end layout start
;; read current row TAGNAME
(setq firstTag (nth 0 (nth csvIndex csvRows)))
(setq currentTag firstTag)
(setq blockRows (list (nth csvIndex csvRows)))
(setq csvIndex (1+ csvIndex))
;; collect following rows with same TAGNAME
(while (and (< csvIndex totalRows)
(equal (nth 0 (nth csvIndex csvRows)) currentTag))
(setq blockRows (append blockRows (list (nth csvIndex csvRows))))
(setq csvIndex (1+ csvIndex))
)
;; now we have blockRows (one or more rows) for currentTag
;; place block at current layoutStartX and posIndex
(placeSequentialDevices layoutStartX posIndex currentTag blockRows)
;; advance posIndex; if it reaches 4 start new layout
(setq posIndex (1+ posIndex))
(if (>= posIndex 4)
(progn (setq posIndex 0) (setq layoutNum (1+ layoutNum)))
)
) ; end while csvIndex < totalRows
;; cleanup
(setvar "ATTREQ" oldAttReq)
(command "_.color" "BYLAYER")
(princ (strcat "\nDone. Processed " (itoa layoutNum) " full layouts (plus partial last layout if any)."))
(princ)
)
)
(devlay_update)
(enable-snap-states)
(princ)
)

557
BNA8/devlay-v2.lsp Normal file
View File

@ -0,0 +1,557 @@
(defun disable-snap-states ()
"Turn OFF Osnap, Ortho, and Object Snap Tracking"
;; Turn OFF Osnap using system variable
(setvar "OSMODE" 0)
(princ "\n<Osnap off>")
;; Turn OFF Ortho
(command "ORTHO" "OFF")
(princ "\n<Ortho off>")
;; Turn OFF Object Snap Tracking using system variable
(setvar "AUTOSNAP" (boole 6 (getvar "AUTOSNAP") 2)) ; Turn off tracking bit
(princ "\n<Object Snap Tracking off>")
(princ "\nSnap states disabled...")
)
(defun enable-snap-states ()
"Turn ON Osnap, Ortho, and Object Snap Tracking"
;; Turn ON Osnap using system variable (common snap modes)
(setvar "OSMODE" 4133) ; Common snap modes: endpoint, midpoint, center, intersection, etc.
(princ "\n<Osnap on>")
;; Turn ON Ortho
(command "ORTHO" "ON")
(princ "\n<Ortho on>")
;; Turn ON Object Snap Tracking using system variable
(setvar "AUTOSNAP" (boole 7 (getvar "AUTOSNAP") 2)) ; Turn on tracking bit
(princ "\n<Object Snap Tracking on>")
(princ "\nSnap states enabled...")
)
;; Function to get attribute value by tag from a list of attributes
(defun getAttVal (attList tag)
(setq tag (strcase tag))
(setq a (vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
))
(if a
(strcase (vl-string-trim " " (vla-get-textstring a)))
""
)
)
;; Function to get attribute object by tag from a list of attributes
(defun getAttObj (attList tag)
(setq tag (strcase tag))
(vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
)
)
;; Function to move TAG1 attribute up and left by 0.5 units
(defun moveTag1UpLeft (block / att basePt newPt)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) "TAG1")
(progn
(setq basePt (vlax-get att 'InsertionPoint))
(setq newPt (list (+ (car basePt) 0.5) (+ (cadr basePt) 0.5) (caddr basePt)))
(vlax-put att 'InsertionPoint newPt)
(if (vlax-property-available-p att 'AlignmentPoint)
(vlax-put att 'AlignmentPoint newPt)
)
(if (vlax-property-available-p att 'TextAlignmentPoint)
(vlax-put att 'TextAlignmentPoint newPt)
)
(vlax-put att 'Color 2)
)
)
)
)
;; Function to set attribute value in a block
(defun setBlockAttr (block tag value)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) (strcase tag))
(vla-put-textstring att value)
)
)
)
;; Function to build pairs of DESCA blocks
(defun build-pairs (maxNum)
(setq result '())
(setq n 1)
(while (<= n maxNum)
(setq a (strcat "DESCA" (if (< n 10) (strcat "0" (itoa n)) (itoa n))))
(setq next (+ n 1))
(if (<= next maxNum)
(setq b (strcat "DESCA" (if (< next 10) (strcat "0" (itoa next)) (itoa next))))
(setq b "")
)
(setq result (append result (list (list a b))))
(setq n (+ n 2))
)
result
)
;; Function to delete existing blocks
(defun delete-existing-devlay-blocks ( / blockNames ss i ent obj)
(setq blockNames '(
"HC01_CORDSET_STR-STR_STRAIGHT"
"CORDSET_STR-STR_1DEVICE PER PORT"
"HC01_SPLITTER"
"HC01_SPLITTER(RIGHT)"
))
(foreach blkName blockNames
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 blkName))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Delete all red circles (used as error indicators)
(setq ss (ssget "_X" '((0 . "CIRCLE") (62 . 1)))) ; 62=1 → red
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Function to process each block type
(defun process-block-type (blkName maxDesca)
(setq filter (list (cons 0 "INSERT") (cons 2 blkName)))
(setq sioLikeBlocks '("PLCIO_ARMORBLOCK_SIO" "PLCIO_ARMBLOCK_FIOM" "PLCIO_ARMORBLOCK_FIOH"))
(setq mirrorThreshold (if (member blkName sioLikeBlocks) 9 7))
(setq ss (ssget "X" filter))
;; Initialize pairs of attributes for DESCA blocks
(if ss
(progn
(princ (strcat "\n[devlay_update] Found blocks named \"" blkName "\"."))
(setq pairs (build-pairs maxDesca))
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq attList (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes))
(foreach pair pairs
(setq val1 (getAttVal attList (car pair)))
(setq val2 (getAttVal attList (cadr pair)))
;; Treat "SPARE" as empty
(if (= val1 "SPARE") (setq val1 ""))
(if (= val2 "SPARE") (setq val2 ""))
;; Case 1: both have values (pairs)
(if (and (/= val1 "") (/= val2 ""))
(progn
(setq att1 (getAttObj attList (car pair)))
(setq att2 (getAttObj attList (cadr pair)))
(if (and att1 att2)
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt1 (vlax-get att1 'InsertionPoint))
(setq pt2 (vlax-get att2 'InsertionPoint))
(setq tagNum (atoi (substr (car pair) 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7))
(setq shiftRightX (if (= tagNum 7) 2.0 0.0))
(setq x1 (+ (car pt1) xOffset shiftRightX))
(setq xCordset (if (>= tagNum mirrorThreshold) (- x1 0.13) x1))
(setq y1 (+ (cadr pt1) 0.1))
(setq newPt1 (list xCordset y1 0.0))
;; NEW: Check if block is FIO or FIOH
(if (or (= blkName "PLCIO_ARMBLOCK_FIOM") (= blkName "PLCIO_ARMORBLOCK_FIOH"))
(progn
(setq newPt1Adjusted
(if (>= tagNum mirrorThreshold)
;; Right side
(list (- (car newPt1) 1.4571) (- (cadr newPt1) 0.6375) (caddr newPt1))
;; Left side
(list (+ (car newPt1) 0.7) (- (cadr newPt1) 0.6375) (caddr newPt1))
)
)
;; Additional shift if TAG7 or TAG8
(if (or (= tagNum 7) (= tagNum 8))
(setq newPt1Adjusted
(list
(- (car newPt1Adjusted) 2.0)
(cadr newPt1Adjusted)
(caddr newPt1Adjusted)
)
)
)
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1Adjusted 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setq tagnumStr (substr (car pair) 6))
(setq tagnum (atoi tagnumStr))
(setq taga1
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
(progn
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
;; Remove last two chars from TAGA value
(setq val (getAttVal attList (strcat "TAGA" evenTagStr)))
(substr val 1 (- (strlen val) 2))
)
(getAttVal attList (strcat "TAGA" tagnumStr))
)
)
(setBlockAttr newBlock1 "TAG1" taga1)
)
(progn
;; EXISTING CODE for all other blocks
(if (and val1 val2
(or (and (vl-string-search "SEL" val1) (vl-string-search "SEL" val2))
(and (vl-string-search "DPM" val1) (vl-string-search "DPM" val2))
;; NEW: Additional conditions for single straight block
(and (vl-string-search "VFD" val1) (vl-string-search "STO" val1)
(vl-string-search "VFD" val2) (vl-string-search "STO" val2))
(and (vl-string-search "JR" val1) (vl-string-search "_PB" val1) (vl-string-search "JR" val2) (vl-string-search "_PB_LT" val2))
(and (vl-string-search "EPC" val1) (vl-string-search "EPC" val2))
(and (vl-string-search "SSP" val1) (vl-string-search "SSP" val2))))
(progn
;; Insert single straight block
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock (vlax-ename->vla-object (entlast)))
;; Set TAG1 attribute
(setq tagnumStr (substr (car pair) 6))
(setq taga (getAttVal attList (strcat "TAGA" tagnumStr)))
(setBlockAttr newBlock "TAG1" taga)
;; Mirror if needed
(setq tagNum (atoi tagnumStr))
(setq finalBlock newBlock) ; assume no mirror
(if (>= tagNum mirrorThreshold)
(progn
(command "_MIRROR" (vlax-vla-object->ename newBlock) "" newPt1 (list (car newPt1) (+ (cadr newPt1) 0.1)) "N")
(entdel (vlax-vla-object->ename newBlock))
(setq finalBlock (vlax-ename->vla-object (entlast))) ; update to mirrored block
)
)
;; === NEW: Move single straight block left/right depending on side ===
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(and (member blkName sioLikeBlocks) (>= tagNum 8)))
;; Right side: move left 1 unit
(progn
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (- (car basePt) 0.5) (cadr basePt) (caddr basePt)))
(vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
;; Left side: move right 0.5 unit
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (<= tagNum 7))
(and (member blkName sioLikeBlocks) (< tagNum 8)))
(progn
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) 1.0) (cadr basePt) (caddr basePt)))
(vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
)
;; === END NEW ===
;; Move all SEL blocks 1 unit down. Also move 4 units left for DESCA07 - 09 (SIO)
(setq shiftX (if (>= tagNum mirrorThreshold) -3 0))
(setq shiftY -0.5)
;; Get current position of block (not assuming newPt1 anymore)
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) shiftX)
(+ (cadr basePt) shiftY)
(caddr basePt)))
(vla-move finalBlock
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
)
(progn
;; ELSE part: Insert two straight blocks + splitter
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setq taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
(setBlockAttr newBlock1 "TAG1" taga1)
(setq y2 (+ (cadr pt2) 0.1))
(setq newPt2 (list xCordset y2 0.0))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
(setq newBlock2 (vlax-ename->vla-object (entlast)))
(setq taga2 (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
(setBlockAttr newBlock2 "TAG1" taga2)
(setq x3 (+ x1 (if (< tagNum mirrorThreshold) 1.25 -1.25)))
(setq y3 (/ (+ y1 y2) 2.0))
(setq newPt3 (list x3 y3 0.0))
(if (< tagNum mirrorThreshold)
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
(progn
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
(setq splitterEnt (vlax-ename->vla-object (entlast)))
(setq newPos (list (- x3 2.2) (+ y3 0.0) 0.0))
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
)
)
;; Extra adjustment for Powerflex DESCA07+ (move all 3 blocks left, splitter up)
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(progn
(setq newX1 (- (car newPt1) 1.8))
(setq newX2 (- (car newPt2) 1.8))
(setq newX3 (- (car newPt3) 1.8))
(setq newY3 (+ (cadr newPt3) 0.0)) ; splitter up
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 (cadr newPt1) (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 (cadr newPt2) (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3)))
)
)
;; If this is the second block type, shift blocks closer together
(if (member blkName sioLikeBlocks)
(progn
(setq moveVecX
(if (or (= tagNum 7) (= tagNum 8))
-1.5
(if (< tagNum mirrorThreshold) 0.5 -1.4)
)
) ; inward move
;; Additional right shift of 0.5 for SIO-like blocks on right side (tagNum >= 9)
(setq rightShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.5 0.0))
;; Additional downward shift of 0.5 for SIO-like blocks on right side (tagNum >= 9)
(setq downShift (if (and (member blkName sioLikeBlocks) (>= tagNum 9)) 0.1 0.0))
(setq newX1 (+ (car newPt1) moveVecX rightShift))
(setq newX2 (+ (car newPt2) moveVecX rightShift))
(setq newX3
(if (or (= tagNum 7) (= tagNum 8))
(+ (car newPt3) -1.5 rightShift)
(+ (car newPt3) moveVecX rightShift)
)
)
(setq newY1 (- (cadr newPt1) downShift))
(setq newY2 (- (cadr newPt2) downShift))
(setq newY3
(if (or (= tagNum 7) (= tagNum 8))
(+ (cadr newPt3) -0.015 downShift)
(- (cadr newPt3) downShift)
)
)
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 newY1 (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 newY2 (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3)))
)
)
)
)
)
)
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; Case 2: single value only
(if (and (/= val1 "") (= val2 ""))
(progn
(setq attTag (if (/= val1 "") (car pair) (cadr pair)))
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt (vlax-get attObj 'InsertionPoint))
(setq tagNum (atoi (substr attTag 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 5.5 -5.0))
(setq x (+ (car pt) xOffset))
(setq y (- (cadr pt) 0.5))
(setq xAdjust
(if (and (member blkName sioLikeBlocks) (>= tagNum 9))
0.0 ; right side → move slightly left
(if (member blkName sioLikeBlocks)
0.7 ; left side → move slightly right
0.0 ; other blocks → no change
)
)
)
;; Extra right shift for Powerflex DESCA07+
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(setq xAdjust (+ xAdjust 1.0))
)
(setq insPt (list (+ x xAdjust) y 0.0))
;; For PLCIO_ARMORPOWERFLEX, special DESCA11 block placement
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(setq insPt (list (+ x 2.0) (+ y 0.5) 0.0))
)
;; Insert proper block based on conditions
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0) ; old block special single
(command "_-INSERT" "CORDSET_STR-STR_1DEVICE PER PORT" insPt 1 1 0) ; other singles
)
(setq newEnt (entlast))
(setq newBlock (vlax-ename->vla-object newEnt))
;; FIX: Keep string version for TAGA, convert to int for comparisons
(setq tagnumStr (substr attTag 6))
(setq tagnum (atoi tagnumStr))
(setq taga
(if (= blkName "PLCIO_ARMORBLOCK_FIOH")
(progn
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
(getAttVal attList (strcat "TAGA" evenTagStr))
)
(getAttVal attList (strcat "TAGA" tagnumStr))
)
)
(setBlockAttr newBlock "TAG1" taga)
;; For non-special single blocks, move attribute
(if (not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11)))
(moveTag1UpLeft newBlock)
)
; Mirror blocks for DESCA07 and above except special single DESCA11
; FIX: Use tagnum (integer) instead of comparing with string
(if (and (>= tagnum mirrorThreshold)
(not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagnum 11))))
(progn
(command "_MIRROR" newEnt "" insPt (list (car insPt) (+ (cadr insPt) 0.1)) "N")
(entdel newEnt)
(setq newBlock (vlax-ename->vla-object (entlast)))
)
)
;; === NEW: Move single straight block left/right depending on side ===
(if (or (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagnum 7))
(and (member blkName sioLikeBlocks) (>= tagnum 8) (= tagnum 15)))
;; Right side: move left 1 unit (only for last DESCA in SIO-like blocks)
(progn
(setq basePt (vlax-get newBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) 0.5) (cadr basePt) (caddr basePt)))
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === NEW: Move SIO-like single blocks on left side to the left ===
(if (and (member blkName sioLikeBlocks) (< tagnum 8))
;; Left side SIO-like blocks: move left 0.5 unit
(progn
(setq basePt (vlax-get newBlock 'InsertionPoint))
(setq targetPt (list (- (car basePt) 0.7) (cadr basePt) (caddr basePt)))
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === END NEW ===
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; ELSE branch: val1 is empty, val2 has value → print warning
(if (and (= val1 "") (/= val2 ""))
(progn
(setq attTag (car pair)) ; Always expect the first attribute to be filled
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
;; Insertion point of the attribute itself
(setq insPt (vlax-get attObj 'InsertionPoint))
;; Draw red circle to mark the issue
(entmakex
(list
(cons 0 "CIRCLE")
(cons 8 "0") ; Layer
(cons 10 insPt) ; Center at attribute
(cons 40 1.3) ; Radius
(cons 62 1) ; Red color
)
)
)
)
)
)
)
(setq i (1+ i))
)
)
(princ (strcat "\n[devlay_update] No blocks named \"" blkName "\" found."))
)
)
(defun c:devlay_update ()
(disable-snap-states)
(delete-existing-devlay-blocks)
(process-block-type "PLCIO_ARMORPOWERFLEX" 11)
(process-block-type "PLCIO_ARMORBLOCK_SIO" 16)
(process-block-type "PLCIO_ARMBLOCK_FIOM" 16)
(process-block-type "PLCIO_ARMORBLOCK_FIOH" 16)
(enable-snap-states)
)

208
layout-base.lsp → BNA8/layout-base-v2.lsp
View File

@ -9,59 +9,6 @@
)
)
(defun insertBlockAt (blockName basePt targetPt)
(command "_.-INSERT" blockName basePt 1 1 0)
(setq ent (entlast))
(vla-move (vlax-ename->vla-object ent)
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
ent
)
(defun labelBlockLines (block startNum)
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "LINE*")
(progn
(setq idx (atoi (substr tag 5)))
(setq labelNum (+ startNum (- idx 1)))
(setq labelStr (if (< labelNum 10)
(strcat "0" (itoa labelNum))
(itoa labelNum)))
(setq basePt (vlax-get att 'InsertionPoint))
(setq labelPt (list (+ (car basePt) 0.55) (- (cadr basePt) 0.05) (caddr basePt)))
(entmake
(list
(cons 0 "TEXT")
(cons 8 "0")
(cons 7 "WD")
(cons 62 7)
(cons 10 labelPt)
(cons 11 labelPt)
(cons 40 0.13)
(cons 72 1)
(cons 73 1)
(cons 1 labelStr)
(cons 50 0.0)
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 100 "AcDbText")
)
)
)
)
)
)
(defun setDESCAtoSpare (block)
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "DESCA*")
(vla-put-textstring att "SPARE")
)
)
)
(defun placeDeviceLabel (vlaBlock / insPt labelText labelPt ent)
(setq insPt (vlax-get vlaBlock 'InsertionPoint))
(setq labelPt (list (+ (car insPt) 3.6) (+ (cadr insPt) 1.2) (caddr insPt)))
@ -70,6 +17,8 @@
(cond
((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*POWERFLEX*") "APF")
((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*SIO*") "SIO")
((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*FIOM*") "FIO")
((wcmatch (strcase (vla-get-effectivename vlaBlock)) "*FIOH*") "FIOH")
(T "")
)
)
@ -96,6 +45,65 @@
)
)
(defun insertBlockAt (blockName basePt targetPt)
(command "_.-INSERT" blockName basePt 1 1 0)
(setq ent (entlast))
(vla-move (vlax-ename->vla-object ent)
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
ent
)
(defun labelBlockLines (block startNum)
(setq counter 0) ; Add a counter to track which attribute we're processing
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "LINE*")
(progn
; Use counter instead of extracting from tag
(setq labelNum (+ startNum counter))
(setq labelStr (if (< labelNum 10)
(strcat "0" (itoa labelNum))
(itoa labelNum)))
;; Use the block's X position + 0.12, and Y from the attribute - 0.053
(setq basePt (vlax-get att 'InsertionPoint))
(setq blockPos (vlax-get block 'InsertionPoint)) ; block base point
;; X from block + 0.12, Y from attribute - 0.053
(setq labelPt (list (+ (car blockPos) 0.12) (- (cadr basePt) 0.053) (caddr basePt)))
(entmakex
(list
(cons 0 "TEXT")
(cons 8 "0")
(cons 7 "WD")
(cons 62 7)
(cons 10 labelPt)
(cons 11 labelPt)
(cons 40 0.13)
(cons 72 1)
(cons 73 1)
(cons 1 labelStr)
(cons 50 0.0)
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 100 "AcDbText")
)
)
(setq counter (1+ counter)) ; Increment counter after processing each LINE attribute
)
)
)
)
(defun setDESCAtoSpare (block)
(foreach att (vlax-invoke block 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (wcmatch tag "DESCA*")
(vla-put-textstring att "SPARE")
)
)
)
;; Function to read device list from a text file
(defun readDeviceListFromFile ( / file filePath line result)
;; Open file dialog for user to pick device list text file
@ -125,31 +133,66 @@
)
;; Function to read device list from file and return as a list
(defun placeDevicesInLayout (layoutStartX devices / basePt positions i blk pos ent)
(defun placeDevicesInLayout (layoutStartX devices / basePt positions i device blk pos ent vlaEnt)
(setq basePt "0,0,0")
;; TODO: these cordinates are for the new SIO BLOCK coming from the amazon
;; They are not used in the current layout, but can be used for future reference.
; (setq positions (list
; (list 3.57 5.06 0.0) ;; A
; (list 3.57 -5.95 0.0) ;; B
; (list 22.84 5.06 0.0) ;; C
; (list 22.84 -5.95 0.0) ;; D
; ))
;; Ordered list of positions: always A, B, C, D
(setq positions (list
(list (+ layoutStartX 9.63) 9.5 0.0) ;; A
(list (+ layoutStartX 9.63) -1.5 0.0) ;; B
(list (+ layoutStartX 28.88) 9.5 0.0) ;; C
(list (+ layoutStartX 28.88) -1.5 0.0) ;; D
(list 9.63 9.5 0.0) ;; A
(list 9.63 -1.5 0.0) ;; B
(list 28.88 9.5 0.0) ;; C
(list 28.88 -1.5 0.0) ;; D
))
;; Alternate layout for FIO/FIOH
(setq positionsB (list
(list 9.6 9.5 0.0) ;; A
(list 9.6 -1.5 0.0) ;; B
(list 28.9666 9.5 0.0) ;; C
(list 28.9666 -1.5 0.0) ;; D
))
(setq i 0)
(while (< i (length devices))
(setq device (nth i devices))
(setq blk
(cond
((vl-string-search "APF" device) "PLCIO_ARMORPOWERFLEX")
((vl-string-search "SIO" device) "PLCIO_ARMORBLOCK_SIO")
((vl-string-search "FIOH" device) "PLCIO_ARMORBLOCK_FIOH")
((vl-string-search "FIO" device) "PLCIO_ARMBLOCK_FIOM")
(T nil)
)
)
(if blk
(progn
(setq pos (nth i positions))
;; Pick the correct layout based on device type and position index
(if (< i (length positions)) ; avoid overflow
(setq pos
(cond
((or (vl-string-search "FIOH" device) (vl-string-search "FIO" device))
(mapcar '+ (nth i positionsB) (list layoutStartX 0 0))
)
(T
(mapcar '+ (nth i positions) (list layoutStartX 0 0))
)
)
)
(setq pos (list layoutStartX 0 0)) ; fallback if too many devices
)
;; Insert and move
(command "_.-INSERT" blk basePt 1 1 0)
(setq ent (entlast))
(if ent
@ -157,7 +200,7 @@
(setq vlaEnt (vlax-ename->vla-object ent))
(vla-move vlaEnt (vlax-3d-point 0 0 0) (vlax-3d-point pos))
(setDESCAtoSpare vlaEnt)
(placeDeviceLabel vlaEnt)
; (placeDeviceLabel vlaEnt)
)
(princ (strcat "\nFailed to insert block: " blk))
)
@ -169,10 +212,46 @@
)
(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue sideOffset / blockObj attrList attr attrName idx newValue formattedValue)
(setq blockObj (vlax-ename->vla-object blockEnt))
(setq attrList (vlax-invoke blockObj 'GetAttributes))
(foreach attr attrList
(setq attrName (vlax-get-property attr 'TagString))
(if (and (>= (strlen attrName) 5)
(= (substr attrName 1 4) "LINE")
(>= (atoi (substr attrName 5)) 1)
(<= (atoi (substr attrName 5)) 20))
(progn
;; Convert string to number; compute base as start + layoutIndex
;; then add per-line index (0-19) and side offset (0 for left, 20 for right)
(setq idx (atoi (substr attrName 5)))
(setq newValue (+ (atoi startValue)
layoutIndex
(- idx 1)
sideOffset))
;; Format as string with period, no leading zeros
(setq formattedValue (strcat (itoa newValue) "."))
;; Apply value
(vlax-put-property attr 'TextString formattedValue)
(vlax-invoke attr 'Update)
)
)
)
(vlax-invoke blockObj 'Update)
)
(defun c:init_layout_base ( / layoutData groupedData layoutCount offsetX i currentOffset basePt ptLeft ptRight leftEnt rightEnt leftBlock rightBlock labelPt)
;; Read layout from file
(setq layoutData (readDeviceListFromFile)) ; from previous step
(setq layoutData (readDeviceListFromFile)) ;
(setq groupedData (chunk-list layoutData 4))
(setq layoutCount (length groupedData))
@ -182,6 +261,9 @@
(setvar "ATTREQ" 0)
(setq offsetX 38.5)
;; prompt user for starting indexes
(setq startIndex (getstring "\nEnter starting line index (e.g. 01600): "))
;; Layout loop
(setq i 0)
(while (< i layoutCount)
@ -204,12 +286,16 @@
(setq ptLeft (list (+ 0.75 currentOffset) 9.5 0))
(setq ptRight (list (+ 20.0 currentOffset) 9.5 0))
;;todo fix the naming
(setq leftEnt (insertBlockAt "20_zone" basePt ptLeft))
(setq leftBlock (vlax-ename->vla-object leftEnt))
(update20ZoneBlockAttributes leftEnt i startIndex 0)
(labelBlockLines leftBlock 1)
(setq rightEnt (insertBlockAt "20_zone" basePt ptRight))
(setq rightBlock (vlax-ename->vla-object rightEnt))
(update20ZoneBlockAttributes rightEnt i startIndex 0)
(labelBlockLines rightBlock 21)
;; Add layout label

370
BNA8/network-diagram-v3.lsp Normal file
View File

@ -0,0 +1,370 @@
no (defun clearDrawing ( / ss)
(setq ss (ssget "_X" '((0 . "*"))))
(if ss (command "_.erase" ss ""))
(princ "\nDrawing cleared.")
)
(defun getVisibilityFromName (deviceName)
(cond
((wcmatch (strcase deviceName) "*APF*") "APF")
((wcmatch (strcase deviceName) "*VFD*") "VFD")
((wcmatch (strcase deviceName) "*SIO*") "SIO")
((wcmatch (strcase deviceName) "*FIO*") "FIO")
((wcmatch (strcase deviceName) "*EX*") "EX")
((wcmatch (strcase deviceName) "*SPARE*") "")
(T "DEFAULT") ;; fallback
)
)
(defun str-trim (s)
(vl-string-trim " \t\n\r" s)
)
(defun setDeviceAttributes (blk ip device port / tag2 tag3 isVFD spacePos slashPos baseName part2 tag ip1 ip2 spacePosIP)
;; Default values
(setq tag2 device)
(setq tag3 "")
(setq ip1 ip)
(setq ip2 "")
;; === VFD logic for tag2 and tag3 ===
(if (and device (vl-string-search "VFD" (strcase device)))
(progn
(setq spacePos (vl-string-search " " device))
(if spacePos
(progn
(setq part1 (substr device 1 spacePos))
(setq part2 (substr device (+ spacePos 2)))
(setq slashPos (vl-string-search "/VFD" part1))
(if slashPos
(setq baseName (substr part1 1 slashPos))
(setq baseName part1)
)
(setq tag2 (str-trim part1))
(setq tag3 (strcat (str-trim baseName) "/" (str-trim part2)))
)
)
)
)
;; === IP splitting logic for ip1 and ip2 ===
(setq spacePosIP (vl-string-search " " ip))
(if spacePosIP
(progn
(setq ip1 (str-trim (substr ip 1 spacePosIP)))
(setq ip2 (str-trim (substr ip (+ spacePosIP 2))))
)
;; else no space, ip2 stays ""
)
;; Set attributes
(foreach att (vlax-invoke blk 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(cond
((= tag "IP") (vla-put-textstring att ip1))
((= tag "IP2") (vla-put-textstring att ip2))
((= tag "TAG2") (vla-put-textstring att tag2))
((= tag "PORT") (vla-put-textstring att port))
((= tag "TAG3") (if (> (strlen tag3) 0) (vla-put-textstring att tag3)))
)
)
)
(defun place-enet-devices (originX originY deviceGroup / blockName width count i x y basePt lastEnt targetPt blk visibilityValue deviceName device ip fullBlockName port)
(setq blockName "HDV2_ENET_DEVICE_")
(setq width 1.2)
(setq count (length deviceGroup))
(setq i 0)
(setq y 20.4718)
(while (< i count)
(setq count (length deviceGroup))
(setq blockSpacing 1.2)
(setq groupWidth (* blockSpacing (1- count)))
(setq centerX 21.2)
(setq startX (- centerX (/ groupWidth 2.0)))
(setq x (+ startX (* i blockSpacing) 0.3))
(setq basePt '(0 0 0))
(setq targetPt (list (+ originX x) (+ originY y) 0))
(setq devicePair (nth i deviceGroup))
(setq device (cdr (assoc "NAME" devicePair)))
(setq ip (cdr (assoc "IP" devicePair)))
(setq port (cdr (assoc "PORT" devicePair)))
;; Create block name based on device visibility
(setq deviceName (getVisibilityFromName device))
(setq fullBlockName (strcat blockName deviceName))
(command "_.-INSERT" fullBlockName basePt 0.8 0.8 0.8 0)
;; Process the inserted block
(if (setq lastEnt (entlast))
(progn
;; Convert to VLA object
(setq blk (vlax-ename->vla-object lastEnt))
;; Move the block to target point
(vla-move blk
(vlax-3d-point basePt)
(vlax-3d-point targetPt)
)
(vla-put-rotation blk 0.0)
(setDeviceAttributes blk ip device port)
)
(princ "\nFailed to get last entity.")
)
(setq i (1+ i))
)
)
(defun labelZone32Lines (ent / vlaBlock att basePt labelPt labelStr height index rotation)
(if (and ent (eq (cdr (assoc 0 (entget ent))) "INSERT"))
(progn
(setq vlaBlock (vlax-ename->vla-object ent))
(setq index 1)
(foreach att (vlax-invoke vlaBlock 'GetAttributes)
(if (wcmatch (strcase (vla-get-tagstring att)) "LINE*")
(progn
(setq labelStr (if (< index 10) (strcat "0" (itoa index)) (itoa index)))
(setq basePt (vlax-get att 'InsertionPoint))
(setq height (vla-get-height att))
(setq rotation (vla-get-rotation att))
(setq labelPt
(list (- (car basePt) 0.05) ; left
(+ (cadr basePt) 0.65) ; up
(caddr basePt)))
;; Create label text
(entmake
(list
(cons 0 "TEXT")
(cons 8 "0")
(cons 7 "WD")
(cons 62 7)
(cons 10 labelPt)
(cons 11 labelPt)
(cons 40 height)
(cons 72 1)
(cons 73 2)
(cons 1 labelStr)
(cons 50 rotation)
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
)
)
(setq index (1+ index))
)
)
)
)
(princ "\nInvalid entity passed to labelZone32Lines.")
)
(princ)
)
(defun parseCSVLine (line / pos result)
(setq result '())
(while (setq pos (vl-string-search "," line))
(setq result (append result (list (substr line 1 pos))))
(setq line (substr line (+ pos 2)))
)
(append result (list line))
)
(defun getDPMDataFromCSV ( / file filename line headers row dpm ip name deviceIP port dpmList deviceGroups currentGroup)
(setq filename (getfiled "Select CSV File" (strcat (getenv "USERPROFILE") "\\Desktop\\") "csv" 0))
(if (not filename)
(progn (princ "\nNo file selected.") (exit))
)
(setq file (open filename "r"))
(if (not file)
(progn (princ "\nFailed to open file.") (exit))
)
;; Read header line
(read-line file)
(setq dpmList '())
(setq deviceGroups '())
(setq currentGroup '())
(while (setq line (read-line file))
(setq row (parseCSVLine line))
(setq dpm (nth 0 row)) ; DPM name (can be empty)
(setq ip (nth 1 row))
(setq name (nth 2 row))
(setq deviceIP (nth 4 row))
(setq port (nth 6 row))
;; If a new DPM is found
(if (and dpm (/= dpm ""))
(progn
;; If current group is not empty, pad and save it
(if (> (length currentGroup) 0)
(progn
(while (< (length currentGroup) 24)
(setq currentGroup
(append currentGroup
(list (list
(cons "NAME" "SPARE")
(cons "IP" "")
(cons "PORT" "")
))
)
)
)
(setq deviceGroups (append deviceGroups (list currentGroup)))
(setq currentGroup '())
)
)
;; Register new DPM
(if (not (assoc dpm dpmList))
(setq dpmList (append dpmList (list (cons dpm ip))))
)
)
)
;; Add valid device (skip blank names)
(if (and name (/= name ""))
(setq currentGroup
(append currentGroup
(list (list
(cons "NAME" name)
(cons "IP" deviceIP)
(cons "PORT" port)
))
)
)
)
;; If group reaches 24 devices — finalize
(if (= (length currentGroup) 24)
(progn
(setq deviceGroups (append deviceGroups (list currentGroup)))
(setq currentGroup '())
)
)
)
;; Handle final group if file ends before 24
(if (> (length currentGroup) 0)
(progn
(while (< (length currentGroup) 24)
(setq currentGroup
(append currentGroup
(list (list
(cons "NAME" "SPARE")
(cons "IP" "")
(cons "PORT" "")
))
)
)
)
(setq deviceGroups (append deviceGroups (list currentGroup)))
)
)
(close file)
(list dpmList deviceGroups)
)
(defun c:init-diagrams ( / blockName count offsetX i x y)
(clearDrawing)
(setq blockName "layout")
(setq csvData (getDPMDataFromCSV))
(setq dpmList (car csvData))
(setq deviceGroups (cadr csvData))
(setq count (length dpmList))
(setq userInput (getstring "\nEnter zone number (e.g., 01, 02): "))
(if (and blockName (> count 0))
(progn
(setq offsetX 43.5)
(setq i 0)
(while (< i count)
(setq x (* i offsetX))
(setq y 0)
(setq basePt '(0 0 0))
(setq targetPt (list x y 0))
;; Insert layout
(command "_.-INSERT" blockName basePt 1 1 0)
(setq lastEnt (entlast))
(if lastEnt
(vla-move
(vlax-ename->vla-object lastEnt)
(vlax-3d-point basePt)
(vlax-3d-point targetPt)
)
)
;; Insert DPM-UPS at fixed offset inside layout
(setq dpmPair (nth i dpmList))
(setq dpmName (car dpmPair))
(setq dpmIP (cdr dpmPair))
(setq deviceGroup (nth i deviceGroups))
(setq dpmUpsPt (list (+ x 16.1) (+ y 2.1173) 0))
(command "_.-INSERT" "DPM-UPS" dpmUpsPt 1 1 0)
;; Set IPADDRESS attribute if found
(setq lastEnt (entlast))
(if lastEnt
(progn
(setq dpmUpsObj (vlax-ename->vla-object lastEnt))
(foreach att (vlax-invoke dpmUpsObj 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(cond
((= tag "IPADDRESS")
(vla-put-textstring att dpmIP)
)
((= tag "TAG2")
(vla-put-textstring att dpmName)
)
)
)
)
)
;; Calculate insertion point
(setq desiredX (+ x 0.7658))
(setq desiredY (+ y 25.6873))
;; Insert ZONE_32H at origin
(command "_.-INSERT" "ZONE_32H" '(0 0 0) 1 1 0)
;; Get the last inserted entity
(setq ent (entlast))
;; Move the inserted block from (0,0,0) to desired point
(if ent
(progn
(setq vlaObj (vlax-ename->vla-object ent))
(vla-move vlaObj (vlax-3d-point 0 0 0) (vlax-3d-point desiredX desiredY 0))
;; Set ALL attributes in the ZONE_32H block to E8912., E8913., etc.
(setq zoneName (strcat userInput (itoa (+ 702 i)) "."))
(foreach att (vlax-invoke vlaObj 'GetAttributes)
(vla-put-textstring att zoneName)
)
;; Label the ZONE_32H lines
(labelZone32Lines ent)
)
)
;; Insert ENETs
(place-enet-devices x y deviceGroup)
(setq i (1+ i))
)
(princ (strcat "\nInserted " (itoa count) " layouts side-by-side."))
)
(princ "\nInvalid input.")
)
(princ)
)

256
BNA8/network-v2.lsp Normal file
View File

@ -0,0 +1,256 @@
(defun readDeviceListFromFile ( / file filePath line result)
;; Open file dialog for user to pick device list text file
(setq filePath (getfiled "Select Device List File" "" "txt" 0))
(if filePath
(progn
(setq file (open filePath "r"))
(setq result '()) ;; initialize empty list before appending
(while (setq line (read-line file))
(setq result (append result (list (strcase (vl-string-trim " \t\r\n" line)))))
)
(close file)
result
)
nil
)
)
(defun updateTagAttribute (ent tagValue / obj attribs att)
;; Convert entity to VLA object
(setq obj (vlax-ename->vla-object ent))
(if (and obj (eq (vla-get-hasattributes obj) :vlax-true))
(progn
(setq attribs (vlax-invoke obj 'GetAttributes))
(foreach att attribs
(if (eq (strcase (vla-get-TagString att)) "TAG1")
(vla-put-TextString att tagValue)
)
)
)
)
)
(defun c:Init_Network ( / dpmCount rowCount colCount i row col x y spacingX spacingY blkName scaleFactor
startPt endPt zigzagStart secondCableEnds zigzagStarts )
(setq blkName "DPM") ; Block name
(setq hdvBlkName "HDV2_1756-EN4TR_CHILD") ; HDV block name
(setq scaleFactor 0.45) ; Scale of each block
(setq spacingX 15.0) ; Horizontal spacing between blocks
(setq spacingY 9.0) ; Vertical spacing between rows
(setq dpmOffsetX 5.0) ; X offset for DPM blocks
(setq hdvY 4.0) ; Y position for HDV block
(setq secondCableEnds '()) ; Store vertical line tops
(setq zigzagStarts '()) ; Store zigzag start points
(command "_.ERASE" "ALL" "")
(setq devices (readDeviceListFromFile))
(if (not devices)
(progn
(princ "\nNo device file selected or file was empty.")
(exit)
)
)
(setq dpmCount (length devices))
;; Calculate grid size
(setq colCount (fix (sqrt dpmCount)))
(if (< (* colCount colCount) dpmCount)
(setq colCount (+ colCount 1))
)
(setq rowCount (fix (/ (+ dpmCount colCount -1) colCount)))
;; Calculate centering offset for DPM blocks
(setq gridWidth (* (- colCount 1) spacingX))
(setq centerOffsetX (- (/ gridWidth 2.0)))
;; Insert HDV block at (0, hdvY) on layer 0
(command "_.LAYER" "S" "0" "")
(command "_.INSERT" hdvBlkName (list 0 hdvY) scaleFactor scaleFactor 0)
;; Loop to place blocks and draw lines
(setq i 0)
(repeat dpmCount
(setq row (fix (/ i colCount)))
(setq col (rem i colCount))
(setq x (+ (* col spacingX) dpmOffsetX)) ; Use variable
(setq y (* -1 row spacingY)) ; No Y offset
(setq dpmName (nth i devices)) ;; get line content
;; Insert DPM block on layer 0
(command "_.LAYER" "S" "0" "")
(command "_.INSERT" blkName (list x y) scaleFactor scaleFactor 0)
;; Get the last inserted entity
(setq ent (entlast))
;; Call the function
(updateTagAttribute ent dpmName)
;; First cable: vertical up
(setq startPt (list (+ x 7.3656) (+ y 4.4406)))
(setq endPt (list (car startPt) (+ (cadr startPt) 2.0)))
(entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
(setq secondCableEnds (append secondCableEnds (list endPt)))
;; Check if last block in row OR last block in entire drawing
(if (or (= (rem (1+ i) colCount) 0) (= i (- dpmCount 1)))
(progn
;; Last block in row or last block overall — elbow and downward
(setq startPt (list (+ x 7.2677) (+ y 3.6094)))
(setq elbowPt (list (- (car startPt) 0.2) (- (cadr startPt) 0.2)))
(entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 elbowPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
(setq endPt (list (car elbowPt) (- (cadr elbowPt) 4.5)))
(entmakex (list '(0 . "LINE") (cons 10 elbowPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
(setq zigzagStarts (append zigzagStarts (list nil))) ; Placeholder
)
(progn
;; Zigzag jump
(setq zigzagStart (list (+ x 7.3656) (+ y 3.7852)))
(setq elbowPt (list (+ x 7.8585) (+ y 5.1262)))
(entmakex (list '(0 . "LINE") (cons 10 zigzagStart) (cons 11 elbowPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Upward line
(setq startPt elbowPt)
(setq endPt (list (car startPt) (+ (cadr startPt) 1.3144)))
(entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 endPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Store the end point of the upward line (second cable's end)
(setq zigzagStarts (append zigzagStarts (list endPt)))
)
)
(setq i (1+ i))
)
;; Connect second cable end to next block's first cable end (if not last in row)
(setq i 0)
(repeat (- dpmCount 1)
(if (/= (rem (1+ i) colCount) 0) ; Only if not last in row
(progn
(setq pt1 (nth i zigzagStarts)) ; Current block's second line end
(setq pt2 (nth (1+ i) secondCableEnds)) ; Next block's first line end
(if (and pt1 pt2 (listp pt1) (listp pt2)) ; Enhanced check
(entmakex
(list
'(0 . "LINE")
(cons 10 pt1)
(cons 11 pt2)
'(62 . 256)
'(8 . "AS_ENET_CABLE")
)
)
)
)
)
(setq i (1+ i))
)
;; Connect last block in row to first block in next row
(setq i 0)
(repeat rowCount
(setq lastInRowIndex (- (* (1+ i) colCount) 1)) ; Last block index in current row
(setq firstInNextRowIndex (* (1+ i) colCount)) ; First block index in next row
(if (and (< lastInRowIndex dpmCount) (< firstInNextRowIndex dpmCount))
(progn
;; Get the downward line end point from last block in row
(setq row i)
(setq col (- colCount 1)) ; Last column
(setq x (+ (* col spacingX) dpmOffsetX)) ; Use variable
(setq y (* -1 row spacingY)) ; Use variable
(setq downwardEndPt (list (- (+ x 7.2677) 0.2) (- (- (+ y 3.6094) 0.2) 4.5)))
;; Get first block coordinates in next row
(setq nextRow (1+ i))
(setq nextCol 0) ; First column
(setq nextX (+ (* nextCol spacingX) dpmOffsetX)) ; Use variable
(setq nextY (* -1 nextRow spacingY)) ; Use variable
(setq nextBlockFirstLineEnd (list (+ nextX 7.3656) (+ (+ nextY 4.4406) 2.0)))
;; Draw horizontal line from downward end to next block's X coordinate
(setq horizontalEndPt (list (car nextBlockFirstLineEnd) (cadr downwardEndPt)))
(entmakex (list '(0 . "LINE") (cons 10 downwardEndPt) (cons 11 horizontalEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Draw vertical line up to next block's first line end
(entmakex (list '(0 . "LINE") (cons 10 horizontalEndPt) (cons 11 nextBlockFirstLineEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
)
)
(setq i (1+ i))
)
;; Connect first block to HDV block
(if (> dpmCount 0)
(progn
;; First block coordinates
(setq firstX (+ (* 0 spacingX) dpmOffsetX)) ; First block X
(setq firstY (* -1 0 spacingY)) ; First block Y (row 0)
;; First block's first line end point
(setq firstBlockEnd (list (+ firstX 7.3656) (+ (+ firstY 4.4406) 2.0)))
;; HDV connection end point
(setq hdvEndPt (list (+ 0 1.4) (- hdvY 2.8))) ; HDV is at (0, hdvY)
;; Step 1: Horizontal line to X destination - 0.5
(setq horizontalEnd (list (+ (car hdvEndPt) 0.5) (cadr firstBlockEnd)))
(entmakex (list '(0 . "LINE") (cons 10 firstBlockEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Step 2: Vertical line to Y destination - 0.5
(setq verticalEnd (list (car horizontalEnd) (+ (cadr hdvEndPt) 0.5)))
(entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 verticalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Step 3: Final line to HDV end point
(entmakex (list '(0 . "LINE") (cons 10 verticalEnd) (cons 11 hdvEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
)
)
;; Connect last block to HDV block
(if (> dpmCount 0)
(progn
;; Last block index and coordinates
(setq lastBlockIndex (- dpmCount 1))
(setq lastRow (fix (/ lastBlockIndex colCount)))
(setq lastCol (rem lastBlockIndex colCount))
(setq lastX (+ (* lastCol spacingX) dpmOffsetX))
(setq lastY (* -1 lastRow spacingY))
;; HDV connection end point for last block
(setq hdvLastEndPt (list (+ 0 0.1) (- hdvY 5.83))) ; HDV is at (0, hdvY)
;; Check if we have only one row
(if (= rowCount 1)
(progn
;; Single row: extend vertical line down by 1.5 units below destination Y, keeping same X
(setq startPt (list (- (+ lastX 7.2677) 0.2) (- (+ lastY 3.6094) 0.2)))
(setq extendedVerticalEnd (list (car startPt) (- (cadr hdvLastEndPt) 1.5)))
(entmakex (list '(0 . "LINE") (cons 10 startPt) (cons 11 extendedVerticalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Horizontal line LEFT to final destination X
(setq horizontalEnd (list (car hdvLastEndPt) (cadr extendedVerticalEnd)))
(entmakex (list '(0 . "LINE") (cons 10 extendedVerticalEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Vertical line UP to final destination
(entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 hdvLastEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
)
(progn
;; Multiple rows: use original 2-segment path
;; Last block's vertical line end point (downward line end)
(setq lastBlockVerticalEnd (list (- (+ lastX 7.2677) 0.2) (- (- (+ lastY 3.6094) 0.2) 4.5)))
;; Step 1: Horizontal line LEFT to X destination
(setq horizontalEnd (list (car hdvLastEndPt) (cadr lastBlockVerticalEnd)))
(entmakex (list '(0 . "LINE") (cons 10 lastBlockVerticalEnd) (cons 11 horizontalEnd) '(62 . 256) '(8 . "AS_ENET_CABLE")))
;; Step 2: Vertical line to final destination
(entmakex (list '(0 . "LINE") (cons 10 horizontalEnd) (cons 11 hdvLastEndPt) '(62 . 256) '(8 . "AS_ENET_CABLE")))
)
)
)
)
(princ)
)

391
devlay.lsp
View File

@ -1,391 +0,0 @@
;; Function to get attribute value by tag from a list of attributes
(defun getAttVal (attList tag)
(setq tag (strcase tag))
(setq a (vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
))
(if a
(strcase (vl-string-trim " " (vla-get-textstring a)))
""
)
)
;; Function to get attribute object by tag from a list of attributes
(defun getAttObj (attList tag)
(setq tag (strcase tag))
(vl-some
(function
(lambda (a)
(if (= (strcase (vla-get-tagstring a)) tag)
a
)
)
)
attList
)
)
;; Function to move TAG1 attribute up and left by 0.5 units
(defun moveTag1UpLeft (block / att basePt newPt)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) "TAG1")
(progn
(setq basePt (vlax-get att 'InsertionPoint))
(setq newPt (list (+ (car basePt) 0.5) (+ (cadr basePt) 0.5) (caddr basePt)))
(vlax-put att 'InsertionPoint newPt)
(if (vlax-property-available-p att 'AlignmentPoint)
(vlax-put att 'AlignmentPoint newPt)
)
(if (vlax-property-available-p att 'TextAlignmentPoint)
(vlax-put att 'TextAlignmentPoint newPt)
)
(vlax-put att 'Color 2)
)
)
)
)
;; Function to set attribute value in a block
(defun setBlockAttr (block tag value)
(foreach att (vlax-invoke block 'GetAttributes)
(if (= (strcase (vla-get-tagstring att)) (strcase tag))
(vla-put-textstring att value)
)
)
)
;; Function to build pairs of DESCA blocks
(defun build-pairs (maxNum)
(setq result '())
(setq n 1)
(while (<= n maxNum)
(setq a (strcat "DESCA" (if (< n 10) (strcat "0" (itoa n)) (itoa n))))
(setq next (+ n 1))
(if (<= next maxNum)
(setq b (strcat "DESCA" (if (< next 10) (strcat "0" (itoa next)) (itoa next))))
(setq b "")
)
(setq result (append result (list (list a b))))
(setq n (+ n 2))
)
result
)
;; Function to delete existing blocks
(defun delete-existing-devlay-blocks ( / blockNames ss i ent obj)
(setq blockNames '(
"HC01_CORDSET_STR-STR_STRAIGHT"
"CORDSET_STR-STR_1DEVICE PER PORT"
"HC01_SPLITTER"
"HC01_SPLITTER(RIGHT)"
))
(foreach blkName blockNames
(setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 blkName))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Delete all red circles (used as error indicators)
(setq ss (ssget "_X" '((0 . "CIRCLE") (62 . 1)))) ; 62=1 → red
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(vla-delete obj)
(setq i (1+ i))
)
)
)
)
;; Function to process each block type
(defun process-block-type (blkName maxDesca)
(setq filter (list (cons 0 "INSERT") (cons 2 blkName)))
(setq mirrorThreshold (if (= blkName "PLCIO_ARMORBLOCK_SIO") 9 7))
(setq ss (ssget "X" filter))
;; Initialize pairs of attributes for DESCA blocks
(if ss
(progn
(princ (strcat "\n[devlay_update] Found blocks named \"" blkName "\"."))
(setq pairs (build-pairs maxDesca))
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq attList (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes))
(foreach pair pairs
(setq val1 (getAttVal attList (car pair)))
(setq val2 (getAttVal attList (cadr pair)))
;; Treat "SPARE" as empty
(if (= val1 "SPARE") (setq val1 ""))
(if (= val2 "SPARE") (setq val2 ""))
;; Case 1: both have values (pairs)
(if (and (/= val1 "") (/= val2 ""))
(progn
(setq att1 (getAttObj attList (car pair)))
(setq att2 (getAttObj attList (cadr pair)))
(if (and att1 att2)
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt1 (vlax-get att1 'InsertionPoint))
(setq pt2 (vlax-get att2 'InsertionPoint))
(setq tagNum (atoi (substr (car pair) 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 4.5 -0.7))
(setq shiftRightX (if (= tagNum 7) 2.0 0.0))
(setq x1 (+ (car pt1) xOffset shiftRightX))
(setq xCordset (if (>= tagNum mirrorThreshold) (- x1 0.13) x1))
(setq y1 (+ (cadr pt1) 0.1))
(setq newPt1 (list xCordset y1 0.0))
(if (and val1 val2
(or (and (vl-string-search "SEL" val1) (vl-string-search "SEL" val2))
(and (vl-string-search "DPM" val1) (vl-string-search "DPM" val2))))
(progn
;; Insert single straight block
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock (vlax-ename->vla-object (entlast)))
;; Set TAG1 attribute
(setq tagnumStr (substr (car pair) 6))
(setq taga (getAttVal attList (strcat "TAGA" tagnumStr)))
(setBlockAttr newBlock "TAG1" taga)
;; Mirror if needed
(setq tagNum (atoi tagnumStr))
(setq mirrorThreshold (if (= blkName "PLCIO_ARMORBLOCK_SIO") 9 7))
(setq finalBlock newBlock) ; assume no mirror
(if (>= tagNum mirrorThreshold)
(progn
(command "_MIRROR" (vlax-vla-object->ename newBlock) "" newPt1 (list (car newPt1) (+ (cadr newPt1) 0.1)) "N")
(entdel (vlax-vla-object->ename newBlock))
(setq finalBlock (vlax-ename->vla-object (entlast))) ; update to mirrored block
)
)
;; Move all SEL blocks 1 unit down. Also move 4 units left for DESCA07 - 09 (SIO)
(setq shiftX (if (>= tagNum mirrorThreshold) -3 0))
(setq shiftY -0.5)
;; Get current position of block (not assuming newPt1 anymore)
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (+ (car basePt) shiftX)
(+ (cadr basePt) shiftY)
(caddr basePt)))
(vla-move finalBlock
(vlax-3d-point basePt)
(vlax-3d-point targetPt))
)
(progn
;; ELSE part: Insert two straight blocks + splitter (old behavior)
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setq taga1 (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
(setBlockAttr newBlock1 "TAG1" taga1)
(setq y2 (+ (cadr pt2) 0.1))
(setq newPt2 (list xCordset y2 0.0))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
(setq newBlock2 (vlax-ename->vla-object (entlast)))
(setq taga2 (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
(setBlockAttr newBlock2 "TAG1" taga2)
(setq x3 (+ x1 (if (< tagNum mirrorThreshold) 1.25 -1.25)))
(setq y3 (/ (+ y1 y2) 2.0))
(setq newPt3 (list x3 y3 0.0))
(if (< tagNum mirrorThreshold)
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
(progn
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
(setq splitterEnt (vlax-ename->vla-object (entlast)))
(setq newPos (list (- x3 2.2) y3 0.0))
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
)
)
;; Extra adjustment for Powerflex DESCA07+ (move all 3 blocks left, splitter up)
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(progn
(setq newX1 (- (car newPt1) 1.8))
(setq newX2 (- (car newPt2) 1.8))
(setq newX3 (- (car newPt3) 1.8))
(setq newY3 (+ (cadr newPt3) 0.0)) ; splitter up
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 (cadr newPt1) (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 (cadr newPt2) (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 newY3 (caddr newPt3)))
)
)
;; If this is the second block type, shift blocks closer together
(if (= blkName "PLCIO_ARMORBLOCK_SIO")
(progn
(setq moveVecX (if (< tagNum mirrorThreshold) 0.5 -1.4)) ; inward move
(setq newX1 (+ (car newPt1) moveVecX))
(setq newX2 (+ (car newPt2) moveVecX))
(setq newX3 (+ (car newPt3) moveVecX))
(vla-move newBlock1 (vlax-3d-point newPt1) (vlax-3d-point newX1 (cadr newPt1) (caddr newPt1)))
(vla-move newBlock2 (vlax-3d-point newPt2) (vlax-3d-point newX2 (cadr newPt2) (caddr newPt2)))
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point newPt3) (vlax-3d-point newX3 (cadr newPt3) (caddr newPt3)))
)
)
)
)
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; Case 2: single value only
(if (and (/= val1 "") (= val2 ""))
(progn
(setq attTag (if (/= val1 "") (car pair) (cadr pair)))
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
(setq oldAttdia (getvar "ATTDIA"))
(setq oldAttreq (getvar "ATTREQ"))
(setvar "ATTDIA" 0)
(setvar "ATTREQ" 0)
(setq pt (vlax-get attObj 'InsertionPoint))
(setq tagNum (atoi (substr attTag 6)))
(setq xOffset (if (< tagNum mirrorThreshold) 5.5 -5.0))
(setq x (+ (car pt) xOffset))
(setq y (- (cadr pt) 0.5))
(setq xAdjust
(if (and (= blkName "PLCIO_ARMORBLOCK_SIO") (>= tagNum 9))
0.5 ; right side → move slightly left
(if (= blkName "PLCIO_ARMORBLOCK_SIO")
0.7 ; left side → move slightly right
0.0 ; other blocks → no change
)
)
)
;; Extra right shift for Powerflex DESCA07+
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (>= tagNum 7))
(setq xAdjust (+ xAdjust 1.0))
)
(setq insPt (list (+ x xAdjust) y 0.0))
;; For PLCIO_ARMORPOWERFLEX, special DESCA11 block placement
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(setq insPt (list (+ x 2.0) (+ y 0.5) 0.0))
)
;; Insert proper block based on conditions
(if (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11))
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" insPt 1 1 0) ; old block special single
(command "_-INSERT" "CORDSET_STR-STR_1DEVICE PER PORT" insPt 1 1 0) ; other singles
)
(setq newEnt (entlast))
(setq newBlock (vlax-ename->vla-object newEnt))
;; FIX: Keep string version for TAGA, convert to int for comparisons
(setq tagnumStr (substr attTag 6))
(setq tagnum (atoi tagnumStr))
(setq taga (getAttVal attList (strcat "TAGA" tagnumStr)))
(setBlockAttr newBlock "TAG1" taga)
;; For non-special single blocks, move attribute
(if (not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagNum 11)))
(moveTag1UpLeft newBlock)
)
;; Mirror blocks for DESCA07 and above except special single DESCA11
;; FIX: Use tagnum (integer) instead of comparing with string
(if (and (>= tagnum mirrorThreshold)
(not (and (= blkName "PLCIO_ARMORPOWERFLEX") (= tagnum 11))))
(progn
(command "_MIRROR" newEnt "" insPt (list (car insPt) (+ (cadr insPt) 0.1)) "N")
(entdel newEnt)
)
)
(setvar "ATTDIA" oldAttdia)
(setvar "ATTREQ" oldAttreq)
)
)
)
)
;; ELSE branch: val1 is empty, val2 has value → print warning
(if (and (= val1 "") (/= val2 ""))
(progn
(setq attTag (car pair)) ; Always expect the first attribute to be filled
(setq attObj (getAttObj attList attTag))
(if attObj
(progn
;; Insertion point of the attribute itself
(setq insPt (vlax-get attObj 'InsertionPoint))
;; Draw red circle to mark the issue
(entmakex
(list
(cons 0 "CIRCLE")
(cons 8 "0") ; Layer
(cons 10 insPt) ; Center at attribute
(cons 40 1.3) ; Radius
(cons 62 1) ; Red color
)
)
)
)
)
)
)
(setq i (1+ i))
)
)
(princ (strcat "\n[devlay_update] No blocks named \"" blkName "\" found."))
)
)
(defun c:devlay_update ()
(delete-existing-devlay-blocks)
(process-block-type "PLCIO_ARMORPOWERFLEX" 11)
(process-block-type "PLCIO_ARMORBLOCK_SIO" 16)
(princ)
)

37
network-diagram-v2.lsp
View File

@ -167,6 +167,28 @@
(princ)
)
(defun setLayoutWireNumbers (layoutEnt zoneNumber layoutIndex / vlaBlock att tag wireNumber cblIndex)
(if (and layoutEnt (eq (cdr (assoc 0 (entget layoutEnt))) "INSERT"))
(progn
(setq vlaBlock (vlax-ename->vla-object layoutEnt))
(setq cblIndex 5) ; Start from CBL05
(foreach att (vlax-invoke vlaBlock 'GetAttributes)
(setq tag (strcase (vla-get-tagstring att)))
(if (= tag "WIRENO")
(progn
(setq wireNumber (strcat zoneNumber (itoa (+ 702 layoutIndex)) "-CBL" (if (< cblIndex 10) (strcat "0" (itoa cblIndex)) (itoa cblIndex))))
(vla-put-textstring att wireNumber)
(setq cblIndex (1+ cblIndex))
)
)
)
)
(princ "\nInvalid layout entity passed to setLayoutWireNumbers.")
)
(princ)
)
(defun parseCSVLine (line / pos result)
(setq result '())
(while (setq pos (vl-string-search "," line))
@ -274,9 +296,6 @@
(list dpmList deviceGroups)
)
(defun c:init-diagrams ( / blockName count offsetX i x y)
(clearDrawing)
(setq blockName "layout")
@ -302,10 +321,14 @@
(command "_.-INSERT" blockName basePt 1 1 0)
(setq lastEnt (entlast))
(if lastEnt
(vla-move
(vlax-ename->vla-object lastEnt)
(vlax-3d-point basePt)
(vlax-3d-point targetPt)
(progn
(vla-move
(vlax-ename->vla-object lastEnt)
(vlax-3d-point basePt)
(vlax-3d-point targetPt)
)
;; Set WIRENO attributes in layout block
(setLayoutWireNumbers lastEnt userInput i)
)
)

3
network-diagram-v3.lsp
View File

@ -274,9 +274,6 @@ no (defun clearDrawing ( / ss)
(list dpmList deviceGroups)
)
(defun c:init-diagrams ( / blockName count offsetX i x y)
(clearDrawing)
(setq blockName "layout")

175
read-csv.lsp
View File

@ -1,175 +0,0 @@
(defun parseCSVLine (line / pos result)
(setq result '())
(while (setq pos (vl-string-search "," line))
(setq result (append result (list (substr line 1 pos))))
(setq line (substr line (+ pos 2)))
)
(append result (list line))
)
(defun getDPMDataFromCSV ( / file filename line headers row dpm ip name dpmList deviceGroups currentGroup)
(setq filename (getfiled "Select CSV File" (strcat (getenv "USERPROFILE") "\\Desktop\\") "csv" 0))
(if (not filename)
(progn (princ "\nNo file selected.") (exit))
)
(setq file (open filename "r"))
(if (not file)
(progn (princ "\nFailed to open file.") (exit))
)
;; Read header line
(read-line file)
(setq dpmList '())
(setq deviceGroups '())
(setq currentGroup '())
(while (setq line (read-line file))
(setq row (parseCSVLine line))
;; DPM name and IP
(setq dpm (nth 0 row))
(setq ip (nth 1 row))
;; Debug output
(princ (strcat "\nProcessing: DPM=" (if dpm dpm "NIL") " IP=" (if ip ip "NIL")))
;; Add unique DPM to list
(if (and dpm (/= dpm "") (not (assoc dpm dpmList)))
(progn
(setq dpmList (append dpmList (list (cons dpm ip))))
(princ (strcat "\nAdded new DPM: " dpm " with IP: " ip))
)
)
;; Device NAME (column 2)
(setq name (nth 2 row))
(if (and name (/= name ""))
(progn
(setq currentGroup (append currentGroup (list name)))
(princ (strcat "\nAdded device: " name " (Group size: " (itoa (length currentGroup)) ")"))
)
)
;; Once 8 devices are collected, add to deviceGroups
(if (= (length currentGroup) 8)
(progn
(setq deviceGroups (append deviceGroups (list currentGroup)))
(princ (strcat "\nCompleted group " (itoa (length deviceGroups)) " with 8 devices"))
(setq currentGroup '())
)
)
)
(close file)
(list dpmList deviceGroups)
)
(defun printDPMData (dpmList deviceGroups / i dpm ip devices device)
(princ "\n--- DPM Data ---")
(princ (strcat "\nTotal DPMs: " (itoa (length dpmList))))
(princ (strcat "\nTotal Device Groups: " (itoa (length deviceGroups))))
(setq i 0)
(foreach dpm dpmList
(princ (strcat "\n\nDPM: " (car dpm)))
(princ (strcat "\nIP: " (cdr dpm)))
(princ "\nDevices:")
(if (< i (length deviceGroups))
(progn
(setq devices (nth i deviceGroups))
(foreach device devices
(princ (strcat "\n - " device))
)
)
(princ "\n No devices found for this DPM")
)
(setq i (1+ i))
)
(princ "\n--- End of Data ---")
)
(defun createTextObjects (dpmList deviceGroups / i dpm ip devices device yPos xPos textContent startY row col)
(setq yPos 0)
(setq xPos 0)
(setq i 0)
(princ "\nCreating text objects...")
(foreach dpm dpmList
(setq startY yPos)
;; Create text for DPM name
(setq textContent (strcat "DPM: " (car dpm)))
(command "TEXT" (list xPos yPos) "2.5" "0" textContent)
(setq yPos (- yPos 5))
;; Create text for IP
(setq textContent (strcat "IP: " (cdr dpm)))
(command "TEXT" (list xPos yPos) "2.0" "0" textContent)
(setq yPos (- yPos 4))
;; Create text for devices in 4x2 grid
(if (< i (length deviceGroups))
(progn
(setq devices (nth i deviceGroups))
(setq row 0)
(setq col 0)
(foreach device devices
;; Calculate position: 4 rows, 2 columns
;; Devices 1,2,3,4 go in left column (col 0)
;; Devices 5,6,7,8 go in right column (col 1)
(if (< row 4)
(setq col 0)
(progn
(setq col 1)
(setq row (- row 4))
)
)
;; Position: left column at xPos, right column at xPos + 40
;; Each row is 3 units apart
(setq textContent device)
(command "TEXT"
(list (+ xPos (* col 40)) (- yPos (* row 3)))
"1.5"
"0"
textContent
)
(setq row (1+ row))
)
)
)
;; Move down for next DPM (leave space for 4 rows + extra spacing)
(setq yPos (- yPos 20))
;; Move to next column if too many entries
(if (< yPos -200)
(progn
(setq xPos (+ xPos 120))
(setq yPos 0)
)
)
(setq i (1+ i))
)
(princ "\nText objects created successfully!")
)
(defun c:getDPMsWithNamesFromCSV ( / result dpmList deviceGroups)
(setq result (getDPMDataFromCSV))
(setq dpmList (nth 0 result))
(setq deviceGroups (nth 1 result))
;; Print the data
(printDPMData dpmList deviceGroups)
;; Create text objects
(createTextObjects dpmList deviceGroups)
(princ)
)