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