73 lines
2.8 KiB
Common Lisp
73 lines
2.8 KiB
Common Lisp
(vl-load-com)
|
|
(defun agent4-num (v) (if (numberp v) (rtos v 2 16) ""))
|
|
(defun agent4-ptx (p) (if (and p (listp p) (numberp (car p))) (rtos (car p) 2 16) ""))
|
|
(defun agent4-pty (p) (if (and p (listp p) (numberp (cadr p))) (rtos (cadr p) 2 16) ""))
|
|
(defun agent4-clean (s) (if s (vl-string-translate "\t\r\n" " " s) ""))
|
|
(defun agent4-bbox (obj / mn mx r)
|
|
(setq r (vl-catch-all-apply 'vla-GetBoundingBox (list obj 'mn 'mx)))
|
|
(if (vl-catch-all-error-p r)
|
|
(list "" "" "" "")
|
|
(progn
|
|
(setq mn (vlax-safearray->list mn))
|
|
(setq mx (vlax-safearray->list mx))
|
|
(list (agent4-ptx mn) (agent4-pty mn) (agent4-ptx mx) (agent4-pty mx))
|
|
)
|
|
)
|
|
)
|
|
(defun agent4-prop-point (obj prop / v)
|
|
(setq v (vl-catch-all-apply 'vlax-get-property (list obj prop)))
|
|
(if (or (null v) (vl-catch-all-error-p v)) nil (vlax-safearray->list (vlax-variant-value v)))
|
|
)
|
|
(defun agent4-prop-text (obj / s)
|
|
(setq s (vl-catch-all-apply 'vlax-get-property (list obj 'TextString)))
|
|
(if (vl-catch-all-error-p s) "" (agent4-clean s))
|
|
)
|
|
(defun agent4-write-child (f parent idx obj / typ txt sp ep ip bb layer)
|
|
(setq typ (vla-get-ObjectName obj))
|
|
(setq txt (agent4-prop-text obj))
|
|
(setq sp (agent4-prop-point obj 'StartPoint))
|
|
(setq ep (agent4-prop-point obj 'EndPoint))
|
|
(setq ip (agent4-prop-point obj 'InsertionPoint))
|
|
(setq bb (agent4-bbox obj))
|
|
(setq layer (vl-catch-all-apply 'vlax-get-property (list obj 'Layer)))
|
|
(if (vl-catch-all-error-p layer) (setq layer ""))
|
|
(write-line
|
|
(strcat parent "\t" (itoa idx) "\t" typ "\t" txt "\t"
|
|
(agent4-ptx sp) "\t" (agent4-pty sp) "\t"
|
|
(agent4-ptx ep) "\t" (agent4-pty ep) "\t"
|
|
(agent4-ptx ip) "\t" (agent4-pty ip) "\t"
|
|
(nth 0 bb) "\t" (nth 1 bb) "\t" (nth 2 bb) "\t" (nth 3 bb) "\t"
|
|
layer "\t" "vla-explode")
|
|
f)
|
|
)
|
|
(defun agent4-read-block-explosions (/ f ss i ent obj parent arr children child idx)
|
|
(setq f (open "D:/CSharpProjects/agent4/runtime/current-standard-flow/33-realign-after-student-dwg-change/22-student-after-save-extraction/block-explosions.tsv" "w"))
|
|
(setq ss (ssget "_X" '((0 . "INSERT"))))
|
|
(if ss
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq ent (ssname ss i))
|
|
(setq obj (vlax-ename->vla-object ent))
|
|
(setq parent (vla-get-Handle obj))
|
|
(setq arr (vl-catch-all-apply 'vla-Explode (list obj)))
|
|
(if (not (vl-catch-all-error-p arr))
|
|
(progn
|
|
(setq children (vlax-safearray->list (vlax-variant-value arr)))
|
|
(setq idx 0)
|
|
(foreach child children
|
|
(agent4-write-child f parent idx child)
|
|
(vl-catch-all-apply 'vla-Delete (list child))
|
|
(setq idx (1+ idx))
|
|
)
|
|
)
|
|
)
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
(if f (close f))
|
|
(princ)
|
|
)
|
|
(agent4-read-block-explosions)
|