This commit is contained in:
Salijoghli 2025-11-21 15:11:29 +04:00
parent 65b3f959a8
commit e9563e61c0
2 changed files with 337 additions and 86 deletions

View File

@ -1,8 +1,6 @@
;;; 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"
@ -39,6 +37,8 @@
(princ "\nSnap states enabled...")
)
;; devlay_update section starts here
;; Function to get attribute value by tag from a list of attributes
(defun getAttVal (attList tag)
(setq tag (strcase tag))
@ -160,7 +160,7 @@
;; 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 sioLikeBlocks '("PLCIO_ARMORBLOCK_SIO" "PLCIO_ARMORBLOCK_FIOM" "PLCIO_ARMORBLOCK_FIOH"))
(setq mirrorThreshold (if (member blkName sioLikeBlocks) 9 7))
(setq ss (ssget "X" filter))
@ -207,18 +207,36 @@
(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"))
(if (or (= blkName "PLCIO_ARMORBLOCK_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))
;; separate handling for FIOM vs FIOH
(cond
;; --- FIOM block placement ---
((= blkName "PLCIO_ARMORBLOCK_FIOM")
(setq newPt1Adjusted
(if (>= tagNum mirrorThreshold)
;; Right side (FIOM)
(list (- (car newPt1) 2.4571) (+ (- (cadr newPt1) 0.6375) 0.25) (caddr newPt1))
;; Left side (FIOM)
(list (+ (car newPt1) 0.9) (+ (- (cadr newPt1) 0.6375) 0.1) (caddr newPt1))
)
)
)
;; --- FIOH block placement ---
((= blkName "PLCIO_ARMORBLOCK_FIOH")
(setq newPt1Adjusted
(if (>= tagNum mirrorThreshold)
;; Right side (FIOH)
(list (- (car newPt1) 1.4571) (- (cadr newPt1) 0.6375) (caddr newPt1))
;; Left side (FIOH)
(list (+ (car newPt1) 0.7) (- (cadr newPt1) 0.6375) (caddr newPt1))
)
)
)
)
;; Additional shift if TAG7 or TAG8
;; --- Additional shift for tag 7 and 8 (applies to both) ---
(if (or (= tagNum 7) (= tagNum 8))
(setq newPt1Adjusted
(list
@ -229,25 +247,115 @@
)
)
(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))
;; === NEW: check if these should produce SPLITTER + TWO CABLES ===
(if (and val1 val2
(or
;; --- TPE paired devices ---
(and (vl-string-search "TPE" val1)
(vl-string-search "TPE" val2)
(/= val1 val2)) ; different names (e.g., TPE2 vs TPE3)
;; --- Receiver / Sender pairs ---
(and (vl-string-search "RCV" val1)
(vl-string-search "SND" val2))
(and (vl-string-search "SND" val1)
(vl-string-search "RCV" val2))
)
)
(getAttVal attList (strcat "TAGA" tagnumStr))
(progn
;; === INSERT TWO CORDS + SPLITTER ===
(setq y2 (+ (cadr pt2) 0.1))
(setq newPt2 (list (car newPt1Adjusted) y2 0.0))
;; 1) First straight
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt1Adjusted 1 1 0)
(setq newBlock1 (vlax-ename->vla-object (entlast)))
(setBlockAttr newBlock1 "TAG1" (getAttVal attList (strcat "TAGA" (substr (car pair) 6))))
;; 2) Second straight
(command "_-INSERT" "HC01_CORDSET_STR-STR_STRAIGHT" newPt2 1 1 0)
(setq newBlock2 (vlax-ename->vla-object (entlast)))
(setBlockAttr newBlock2 "TAG1" (getAttVal attList (strcat "TAGA" (substr (cadr pair) 6))))
;; 3) Splitter between them
(setq x3 (+ (car newPt1Adjusted) (if (< tagNum mirrorThreshold) 1.25 -1.25)))
(setq y3 (/ (+ (cadr newPt1Adjusted) y2) 2.0))
(setq newPt3 (list x3 y3 0.0))
(if (< tagNum mirrorThreshold)
(progn
(command "_-INSERT" "HC01_SPLITTER" newPt3 1 1 0)
(setq splitterEnt (vlax-ename->vla-object (entlast))) ; capture splitter
)
(progn
(command "_-INSERT" "HC01_SPLITTER(RIGHT)" newPt3 1 1 0)
(setq splitterEnt (vlax-ename->vla-object (entlast))) ; capture splitter
(setq newPos (list (- x3 2.2) (+ y3 0.0) 0.0))
(vla-move splitterEnt (vlax-3d-point newPt3) (vlax-3d-point newPos))
)
)
;; === SHIFT WHOLE GROUP UP AND LEFT (after inserting two cords + splitter) ===
(setq moveX -0.5) ; left shift
(setq moveY 0.5) ; upward shift
(vla-move newBlock1 (vlax-3d-point newPt1Adjusted)
(vlax-3d-point (+ (car newPt1Adjusted) moveX)
(+ (cadr newPt1Adjusted) moveY)
(caddr newPt1Adjusted)))
(vla-move newBlock2 (vlax-3d-point newPt2)
(vlax-3d-point (+ (car newPt2) moveX)
(- (cadr newPt2) 0.1)
(caddr newPt2)))
;; Ensure splitterEnt exists for both sides
(if (not splitterEnt)
(setq splitterEnt (vlax-ename->vla-object (entlast)))
)
;; Move splitter
(if splitterEnt
(vla-move splitterEnt
(vlax-3d-point newPt3)
(vlax-3d-point (+ (car newPt3) moveX)
(+ (- (cadr newPt3) 0.3) moveY)
(caddr newPt3)))
)
)
(progn
;; === DEFAULT: single straight (same as before) ===
(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
(cond
;; --- FIOH: even number logic + trim last 2 chars ---
((= blkName "PLCIO_ARMORBLOCK_FIOH")
(setq evenNum (if (= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq evenTagStr (if (< evenNum 10) (strcat "0" (itoa evenNum)) (itoa evenNum)))
(setq val (getAttVal attList (strcat "TAGA" evenTagStr)))
(substr val 1 (- (strlen val) 2))
)
;; --- FIOM: simple value + trim last 2 chars (remove _0 etc.) ---
((= blkName "PLCIO_ARMORBLOCK_FIOM")
(setq val (getAttVal attList (strcat "TAGA" tagnumStr)))
(substr val 1 (- (strlen val) 2))
)
;; --- Default for other blocks ---
(T (getAttVal attList (strcat "TAGA" tagnumStr)))
)
)
(setBlockAttr newBlock1 "TAG1" taga1)
)
)
(setBlockAttr newBlock1 "TAG1" taga1)
)
(progn
;; EXISTING CODE for all other blocks
(if (and val1 val2
@ -288,7 +396,7 @@
;; Right side: move left 1 unit
(progn
(setq basePt (vlax-get finalBlock 'InsertionPoint))
(setq targetPt (list (- (car basePt) 0.5) (cadr basePt) (caddr basePt)))
(setq targetPt (list (- (car basePt) 0.0) (cadr basePt) (caddr basePt)))
(vla-move finalBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
;; Left side: move right 0.5 unit
@ -463,15 +571,17 @@
(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))
;; Make sure tag number is always odd
(setq oddNum (if (/= (rem tagnum 2) 0) tagnum (+ tagnum 1)))
(setq oddTagStr (if (< oddNum 10) (strcat "0" (itoa oddNum)) (itoa oddNum)))
(getAttVal attList (strcat "TAGA" oddTagStr))
)
(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)
@ -490,14 +600,18 @@
;; === 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)
(and (member blkName sioLikeBlocks)
(not (= blkName "PLCIO_ARMORBLOCK_FIOM")) ; exclude FIOM
(>= tagnum 8)
(= tagnum 15)))
;; Right side: move left 1 unit (only for last DESCA in SIO-like blocks, excluding FIOM)
(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))
@ -508,6 +622,16 @@
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === NEW: Final vertical adjustment for FIOM single blocks ===
(if (= blkName "PLCIO_ARMORBLOCK_FIOM")
(progn
(setq basePt (vlax-get newBlock 'InsertionPoint))
(setq targetPt (list (car basePt) (+ (cadr basePt) 0.2) (caddr basePt)))
(vla-move newBlock (vlax-3d-point basePt) (vlax-3d-point targetPt))
)
)
;; === END NEW ===
(setvar "ATTDIA" oldAttdia)
@ -555,12 +679,13 @@
(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_FIOM" 16)
(process-block-type "PLCIO_ARMORBLOCK_FIOH" 16)
(princ)
)
;;; devlay_update section ends here
;; devlay_update section ends here
;;; -----------------------
;;; Utilities
@ -715,6 +840,7 @@
)
)
;;; -----------------------
;;; Device placement — sequential TAGNAME grouping approach
;;; layoutDevices not precomputed: we use csvRows + csvIndex and group rows by TAGNAME
@ -731,31 +857,61 @@
((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")
((vl-string-search "FIO" devUpper) "PLCIO_ARMORBLOCK_FIOM")
(T nil)
)
)
;; positions arrays
;; --- Base position templates ---
(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)))
;; FIOH positions (Hub old spacing)
(setq positionsFIOH (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)))
;; FIO positions (new, slightly taller/wider)
(setq positionsFIO (list
(list 9.6 9.85 0.0)
(list 9.6 -1.15 0.0)
(list 28.9666 9.85 0.0)
(list 28.9666 -1.15 0.0)))
;; --- Determine which set of positions to use ---
(cond
((vl-string-search "FIOH" devUpper)
(setq pos (mapcar '+ (nth posIndex positionsFIOH) (list layoutStartX 0 0))))
((vl-string-search "FIO" devUpper)
(setq pos (mapcar '+ (nth posIndex positionsFIO) (list layoutStartX 0 0))))
(T
(setq pos (mapcar '+ (nth posIndex positions) (list layoutStartX 0 0))))
)
;; --- Insert and populate ---
(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)
;; --- FIOM-specific 20_zone adjustment (left & right) ---
(if (and blk (vl-string-search "FIOM" (strcase deviceTag)))
(progn
(cond
((member posIndex '(0 1)) ; left side
(adjust20ZoneForFIOM *curr-left-zone* posIndex)
(setq *fiom-left-pos* posIndex))
((member posIndex '(2 3)) ; right side
(adjust20ZoneForFIOM *curr-right-zone* posIndex)
(setq *fiom-right-pos* posIndex))
)
)
)
(setq ent (entlast))
(if ent
(progn
@ -771,52 +927,137 @@
)
;;; -----------------------
;;; 20_zone helpers (unchanged logic)
;;; 20_zone helpers
;;; -----------------------
(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 fmt2 (n)
(if (< n 10)
(strcat "0" (itoa n))
(itoa n))
)
(defun to-int (x)
(if (numberp x) x (atoi x))
)
(defun update20ZoneBlockAttributes (blockEnt layoutIndex startValue suffixBase sideOffset
/ blockObj attrList sortedList attrPair idx intBase intPart suffixPart newText)
"Update LINE## attributes with values like 2600.01 ... 2600.40.
Fixes unordered attribute iteration by sorting numerically first."
(setq blockObj (vlax-ename->vla-object blockEnt))
(setq attrList (vlax-invoke blockObj 'GetAttributes))
;; integer part (constant for all lines in block)
(setq intBase (to-int startValue))
(setq intPart (+ intBase (to-int layoutIndex) (to-int sideOffset)))
;; sort attributes by numeric LINE## suffix
(setq sortedList
(vl-sort
(mapcar
'(lambda (a)
(list (atoi (substr (vla-get-tagstring a) 5)) a))
attrList)
'(lambda (x y) (< (car x) (car y))))
)
;; now loop in correct order
(setq idx 0)
(foreach attrPair sortedList
(setq idx (1+ idx))
(setq attr (cadr attrPair))
(setq suffixPart (fmt2 (+ suffixBase (1- idx))))
(setq newText (strcat (itoa intPart) "." suffixPart))
(vla-put-textstring attr newText)
(vlax-invoke attr 'Update)
)
(vlax-invoke blockObj 'Update)
)
;;; -----------------------
;;; FIOM-specific adjustments for 20_zone
;;; -----------------------
;; vertical Y-offsets for 8 lines in FIOM layouts
(setq *FIOM-YOFFSETS*
'(
(1 . 0.26)
(2 . 0.78)
(3 . 1.16)
(4 . 1.64)
(5 . 1.89)
(6 . 2.40)
(7 . 2.79)
(8 . 3.28)
)
)
(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)
(defun fiom-yoffset (relIndex / hit)
(setq hit (assoc relIndex *FIOM-YOFFSETS*))
(if hit (cdr hit) 0.0)
)
(defun adjust20ZoneForFIOM (zoneEnt posIndex / blockObj attList idx relIdx lineIndices a pt yoff newPt)
"Shift the correct 8 attributes of 20_zone block when FIOM exists (top/bottom, left/right),
and set justification to Middle Left for those lines only."
(if (null zoneEnt)
(princ "\n[FIOM] zone block not found.")
(progn
;; which 8 attributes to move based on FIOM position
(setq lineIndices
(cond
((= posIndex 0) '(1 2 3 4 5 6 7 8)) ; top-left
((= posIndex 1) '(12 13 14 15 16 17 18 19)) ; bottom-left
((= posIndex 2) '(1 2 3 4 5 6 7 8)) ; top-right
((= posIndex 3) '(12 13 14 15 16 17 18 19)) ; bottom-right
(T nil)
)
)
(if lineIndices
(progn
(setq blockObj (vlax-ename->vla-object zoneEnt))
(setq attList (vlax-invoke blockObj 'GetAttributes))
(setq idx 1)
(foreach a attList
(if (member idx lineIndices)
(progn
(setq relIdx (1+ (vl-position idx lineIndices))) ; 1..8
(setq pt (vlax-get a 'InsertionPoint))
(setq yoff (fiom-yoffset relIdx))
;; set justification to Middle Left (9) BEFORE changing position
(if (vlax-property-available-p a 'Alignment)
(vlax-put a 'Alignment 9)) ; 9 = acAlignmentMiddleLeft
;; move only vertically
(setq newPt (list (car pt) (+ (cadr pt) yoff) (caddr pt)))
;; For Middle Left, use TextAlignmentPoint
(if (vlax-property-available-p a 'TextAlignmentPoint)
(vlax-put a 'TextAlignmentPoint newPt))
;; update attribute
(vlax-invoke a 'Update)
)
)
(setq idx (1+ idx))
)
(vlax-invoke blockObj 'Update)
)
)
)
)
(vlax-invoke blockObj 'Update)
)
;;; -----------------------
;;; MAIN FUNCTION
;;; -----------------------
(setq *curr-left-zone* nil)
(setq *curr-right-zone* nil)
(setq *fiom-left-pos* nil) ; stores posIndex when FIOM placed on left
(setq *fiom-right-pos* nil) ; stores posIndex when FIOM placed on right
(defun c:init_layout ( / csvFile csvRows file line cols headerSkipped csvIndex totalRows layoutNum layoutStartX posIndex blocksLeft numBlocksInLayout layoutDevices firstTag currentTag blockRows)
(disable-snap-states)
@ -861,6 +1102,10 @@
(if (= posIndex 0)
(progn
(setq layoutStartX (* layoutNum offsetX))
;; Reset FIOM tracking for new layout
(setq *fiom-left-pos* nil)
(setq *fiom-right-pos* nil)
;; draw outer box and lines (same as before)
(command "_.PLINE" (list (+ 0 layoutStartX) -11.0))
(command (list (+ 38.5 layoutStartX) -11.0))
@ -877,19 +1122,22 @@
(setq ptRight (list (+ 20.0 layoutStartX) 9.5 0))
(setq leftEnt (insertBlockAt "20_zone" basePt ptLeft))
(setq *curr-left-zone* leftEnt)
(setq *curr-right-zone* nil) ; initialize right zone tracker
(if leftEnt
(progn
(setq leftBlock (vlax-ename->vla-object leftEnt))
(update20ZoneBlockAttributes leftEnt layoutNum startIndex 0)
(labelBlockLines leftBlock 1)
(update20ZoneBlockAttributes leftEnt layoutNum startIndex 1 0)
; (labelBlockLines leftBlock 1 nil) ; ADD nil parameter
)
)
(setq rightEnt (insertBlockAt "20_zone" basePt ptRight))
(setq *curr-right-zone* rightEnt) ; store right zone
(if rightEnt
(progn
(setq rightBlock (vlax-ename->vla-object rightEnt))
(update20ZoneBlockAttributes rightEnt layoutNum startIndex 0)
(labelBlockLines rightBlock 21)
(update20ZoneBlockAttributes rightEnt layoutNum startIndex 21 0)
; (labelBlockLines rightBlock 21 nil) ; ADD nil parameter
)
)
;; layout label

View File

@ -380,6 +380,9 @@
)
)
;; layout label
(setq labelPt (list (+ desiredX 14.0) 32.0 0.0))
(command "_.text" labelPt 1.5 0 (strcat "Layout " (itoa (1+ i))))
(place-enet-devices x y deviceGroup)
(setq i (1+ i))
)