autocad/BNA8/network-diagram-v3.lsp

371 lines
11 KiB
Common Lisp

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)
)