49 lines
1.7 KiB
Common Lisp
49 lines
1.7 KiB
Common Lisp
(vl-load-com)
|
|
(defun agent4-format-point (p)
|
|
(if (and p (listp p) (numberp (car p)) (numberp (cadr p)))
|
|
(strcat (rtos (car p) 2 16) "\t" (rtos (cadr p) 2 16))
|
|
"\t"
|
|
)
|
|
)
|
|
(defun agent4-start-point (obj / param point)
|
|
(setq param (vl-catch-all-apply 'vlax-curve-getStartParam (list obj)))
|
|
(if (not (vl-catch-all-error-p param))
|
|
(setq point (vl-catch-all-apply 'vlax-curve-getPointAtParam (list obj param)))
|
|
)
|
|
(if (or (null point) (vl-catch-all-error-p point))
|
|
(setq point (vl-catch-all-apply 'vlax-curve-getStartPoint (list obj)))
|
|
)
|
|
(if (vl-catch-all-error-p point) nil point)
|
|
)
|
|
(defun agent4-end-point (obj / param point)
|
|
(setq param (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)))
|
|
(if (not (vl-catch-all-error-p param))
|
|
(setq point (vl-catch-all-apply 'vlax-curve-getPointAtParam (list obj param)))
|
|
)
|
|
(if (or (null point) (vl-catch-all-error-p point))
|
|
(setq point (vl-catch-all-apply 'vlax-curve-getEndPoint (list obj)))
|
|
)
|
|
(if (vl-catch-all-error-p point) nil point)
|
|
)
|
|
(defun agent4-write-spline-endpoints (/ f ss i ent obj h sp ep)
|
|
(setq f (open "D:/CSharpProjects/agent4/runtime/current-standard-flow/36-current-drawing-calibration/autocad-extraction-inner-frame-live/spline-endpoints.tsv" "w"))
|
|
(setq ss (ssget "_X" '((0 . "SPLINE"))))
|
|
(if ss
|
|
(progn
|
|
(setq i 0)
|
|
(while (< i (sslength ss))
|
|
(setq ent (ssname ss i))
|
|
(setq obj (vlax-ename->vla-object ent))
|
|
(setq h (vla-get-Handle obj))
|
|
(setq sp (agent4-start-point obj))
|
|
(setq ep (agent4-end-point obj))
|
|
(write-line (strcat h "\t" (agent4-format-point sp) "\t" (agent4-format-point ep)) f)
|
|
(setq i (1+ i))
|
|
)
|
|
)
|
|
)
|
|
(if f (close f))
|
|
(princ)
|
|
)
|
|
(agent4-write-spline-endpoints)
|