936 lines
38 KiB
Common Lisp
936 lines
38 KiB
Common Lisp
;;; 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 "VFD" devUpper) "PLCIO_ARMORPOWERFLEX")
|
|
((vl-string-search "APF" devUpper) "PLCIO_ARMORPOWERFLEX")
|
|
((vl-string-search "SIO" devUpper) "PLCIO_ARMORBLOCK_SIO")
|
|
((vl-string-search "FIOH" devUpper) "PLCIO_ARMORBLOCK_FIOH")
|
|
((vl-string-search "FIO" devUpper) "PLCIO_ARMBLOCK_FIOM")
|
|
(T nil)
|
|
)
|
|
)
|
|
;; positions arrays
|
|
(setq positions (list
|
|
(list 9.63 9.5 0.0)
|
|
(list 9.63 -1.5 0.0)
|
|
(list 28.88 9.5 0.0)
|
|
(list 28.88 -1.5 0.0)))
|
|
(setq positionsB (list
|
|
(list 9.6 9.5 0.0)
|
|
(list 9.6 -1.5 0.0)
|
|
(list 28.9666 9.5 0.0)
|
|
(list 28.9666 -1.5 0.0)))
|
|
|
|
(if blk
|
|
(progn
|
|
;; compute insertion pos using posIndex and layoutStartX
|
|
(setq pos (if (or (vl-string-search "FIOH" devUpper) (vl-string-search "FIO" devUpper))
|
|
(mapcar '+ (nth posIndex positionsB) (list layoutStartX 0 0))
|
|
(mapcar '+ (nth posIndex positions) (list layoutStartX 0 0))))
|
|
|
|
;; insert and fill
|
|
(insertBlockAt blk '(0 0 0) pos)
|
|
(setq ent (entlast))
|
|
(if ent
|
|
(progn
|
|
(setq vlaEnt (vlax-ename->vla-object ent))
|
|
(setDESCAtoSpare vlaEnt)
|
|
(populateBlockAttributes vlaEnt blockRows)
|
|
)
|
|
(princ (strcat "\nFailed to insert block: " blk))
|
|
)
|
|
)
|
|
(princ (strcat "\nWarning: could not determine block type for: " deviceTag))
|
|
)
|
|
)
|
|
|
|
;;; -----------------------
|
|
;;; 20_zone helpers (unchanged logic)
|
|
;;; -----------------------
|
|
(defun labelBlockLines (block startNum)
|
|
(setq counter 0)
|
|
(foreach att (vlax-invoke block 'GetAttributes)
|
|
(setq tag (strcase (vla-get-tagstring att)))
|
|
(if (wcmatch tag "LINE*")
|
|
(progn
|
|
(setq labelNum (+ startNum counter))
|
|
(setq labelStr (if (< labelNum 10) (strcat "0" (itoa labelNum)) (itoa labelNum)))
|
|
(setq basePt (vlax-get att 'InsertionPoint))
|
|
(setq blockPos (vlax-get block 'InsertionPoint))
|
|
(setq labelPt (list (+ (car blockPos) 0.12) (- (cadr basePt) 0.053) (caddr basePt)))
|
|
(entmakex (list (cons 0 "TEXT") (cons 8 "0") (cons 7 "WD") (cons 62 7)
|
|
(cons 10 labelPt) (cons 11 labelPt) (cons 40 0.13) (cons 72 1)
|
|
(cons 73 1) (cons 1 labelStr) (cons 50 0.0)))
|
|
(setq counter (1+ counter))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue sideOffset / blockObj attrList attr attrName idx newValue formattedValue)
|
|
(setq blockObj (vlax-ename->vla-object blockEnt))
|
|
(setq attrList (vlax-invoke blockObj 'GetAttributes))
|
|
(foreach attr attrList
|
|
(setq attrName (vlax-get-property attr 'TagString))
|
|
(if (and (>= (strlen attrName) 5)
|
|
(= (substr attrName 1 4) "LINE")
|
|
(>= (atoi (substr attrName 5)) 1)
|
|
(<= (atoi (substr attrName 5)) 20))
|
|
(progn
|
|
(setq idx (atoi (substr attrName 5)))
|
|
(setq newValue (+ (atoi startValue) layoutIndex (- idx 1) sideOffset))
|
|
(setq formattedValue (strcat (itoa newValue) "."))
|
|
(vlax-put-property attr 'TextString formattedValue)
|
|
(vlax-invoke attr 'Update)
|
|
)
|
|
)
|
|
)
|
|
(vlax-invoke blockObj 'Update)
|
|
)
|
|
|
|
;;; -----------------------
|
|
;;; MAIN FUNCTION
|
|
;;; -----------------------
|
|
(defun c:init_layout ( / csvFile csvRows file line cols headerSkipped csvIndex totalRows layoutNum layoutStartX posIndex blocksLeft numBlocksInLayout layoutDevices firstTag currentTag blockRows)
|
|
(disable-snap-states)
|
|
|
|
;; select CSV
|
|
(setq csvFile (getfiled "Select source CSV file" "" "csv" 0))
|
|
(if (not csvFile) (progn (princ "\nNo CSV file selected. Aborting.") (princ))
|
|
(progn
|
|
;; read CSV lines into list, skipping header (first non-empty line)
|
|
(setq csvRows '())
|
|
(setq file (open csvFile "r"))
|
|
(setq headerSkipped nil)
|
|
(while (setq line (read-line file))
|
|
(if (not (= line ""))
|
|
(progn
|
|
(if headerSkipped
|
|
(progn
|
|
(setq cols (split-csv-line line))
|
|
(setq csvRows (append csvRows (list cols)))
|
|
)
|
|
(setq headerSkipped T) ; first non-empty row considered header and skipped
|
|
)
|
|
)
|
|
)
|
|
)
|
|
(close file)
|
|
|
|
;; prepare drawing
|
|
(setq oldAttReq (getvar "ATTREQ")) (setvar "ATTREQ" 0)
|
|
(setq offsetX 38.5)
|
|
|
|
;; user start index (keeps old behavior for 20_zone)
|
|
(setq startIndex (getstring "\nEnter starting line index (e.g. 01600): "))
|
|
|
|
;; sequential processing
|
|
(setq csvIndex 0)
|
|
(setq totalRows (length csvRows))
|
|
(setq layoutNum 0)
|
|
(setq posIndex 0) ; position within current layout (0..3)
|
|
|
|
(while (< csvIndex totalRows)
|
|
;; if starting a new layout (posIndex == 0) draw the layout box and 20_zone blocks
|
|
(if (= posIndex 0)
|
|
(progn
|
|
(setq layoutStartX (* layoutNum offsetX))
|
|
;; draw outer box and lines (same as before)
|
|
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0))
|
|
(command (list (+ 38.5 layoutStartX) -11.0))
|
|
(command (list (+ 38.5 layoutStartX) 11.0))
|
|
(command (list (+ 0 layoutStartX) 11.0))
|
|
(command "C")
|
|
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0) (list (+ 0 layoutStartX) 11.0) "")
|
|
(command "_.PLINE" (list (+ 38.5 layoutStartX) -11.0) (list (+ 38.5 layoutStartX) 11.0) "")
|
|
(command "_.PLINE" (list (+ 19.25 layoutStartX) -11.0) (list (+ 19.25 layoutStartX) 11.0) "")
|
|
|
|
;; Insert 20_zone left & right and label them
|
|
(setq basePt '(0 0 0))
|
|
(setq ptLeft (list (+ 0.75 layoutStartX) 9.5 0))
|
|
(setq ptRight (list (+ 20.0 layoutStartX) 9.5 0))
|
|
|
|
(setq leftEnt (insertBlockAt "20_zone" basePt ptLeft))
|
|
(if leftEnt
|
|
(progn
|
|
(setq leftBlock (vlax-ename->vla-object leftEnt))
|
|
(update20ZoneBlockAttributes leftEnt layoutNum startIndex 0)
|
|
(labelBlockLines leftBlock 1)
|
|
)
|
|
)
|
|
(setq rightEnt (insertBlockAt "20_zone" basePt ptRight))
|
|
(if rightEnt
|
|
(progn
|
|
(setq rightBlock (vlax-ename->vla-object rightEnt))
|
|
(update20ZoneBlockAttributes rightEnt layoutNum startIndex 0)
|
|
(labelBlockLines rightBlock 21)
|
|
)
|
|
)
|
|
;; layout label
|
|
(setq labelPt (list (+ layoutStartX 14.0) 16.0 0.0))
|
|
(command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ layoutNum))))
|
|
)
|
|
) ; end layout start
|
|
|
|
;; read current row TAGNAME
|
|
(setq firstTag (nth 0 (nth csvIndex csvRows)))
|
|
(setq currentTag firstTag)
|
|
(setq blockRows (list (nth csvIndex csvRows)))
|
|
(setq csvIndex (1+ csvIndex))
|
|
|
|
;; collect following rows with same TAGNAME
|
|
(while (and (< csvIndex totalRows)
|
|
(equal (nth 0 (nth csvIndex csvRows)) currentTag))
|
|
(setq blockRows (append blockRows (list (nth csvIndex csvRows))))
|
|
(setq csvIndex (1+ csvIndex))
|
|
)
|
|
|
|
;; now we have blockRows (one or more rows) for currentTag
|
|
;; place block at current layoutStartX and posIndex
|
|
(placeSequentialDevices layoutStartX posIndex currentTag blockRows)
|
|
|
|
;; advance posIndex; if it reaches 4 start new layout
|
|
(setq posIndex (1+ posIndex))
|
|
(if (>= posIndex 4)
|
|
(progn (setq posIndex 0) (setq layoutNum (1+ layoutNum)))
|
|
)
|
|
) ; end while csvIndex < totalRows
|
|
|
|
;; cleanup
|
|
(setvar "ATTREQ" oldAttReq)
|
|
(command "_.color" "BYLAYER")
|
|
(princ (strcat "\nDone. Processed " (itoa layoutNum) " full layouts (plus partial last layout if any)."))
|
|
(princ)
|
|
)
|
|
)
|
|
(devlay_update)
|
|
(enable-snap-states)
|
|
(princ)
|
|
)
|