557 lines
24 KiB
Common Lisp
557 lines
24 KiB
Common Lisp
(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)
|
|
) |