lisp坐标⼀键⽣成_提取点坐标-AutoLISPVisualLISP编程技术-
CAD论坛。。。
只选择纵线[code="lisp]lambda编程
(vl-load-com)
(defun c:tt (/ ss lst lst1 m n x y f)
(defun x_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
)
(defun deldup        (ptLst alw / pt1)
(cond ((<= (length ptLst) 1) ptLst)
(t
(setq pt1 (car ptLst))
(cons pt1
(vl-remove-if
'(lambda (x) (equal pt1 x alw))
(deldup (cdr ptLst) alw)
)
)
)
)
)
(defun get_dxf (en num /) (cdr (assoc num (entget en))))
(setq f (open (getfiled "坐标输出为：" "d:/" "txt" 1) "w"))
(prompt "\n仅选择纵向线：")
(setq        ss  (ssget)
lst (x_ssn ss)
lst (vl-sort
lst
'(lambda (x y) (< (car (get_dxf x 10)) (car (get_dxf y 10))))
)
)
(foreach n lst
(setq ss (ssget "f" (list (get_dxf n 10) (get_dxf n 11)))) (setq lst1 (x_ssn ss))
(setq lst1 (deldup (vl-remove nil
(mapcar '(lambda (x)
(vlax-invoke
(vlax-ename->vla-object n)
'IntersectWith
(vlax-ename->vla-object x)
acExtendNone
)
)
lst1
)
)
1e-6
)
lst1 (vl-sort lst1 '(lambda (x y) (< (cadr x) (cadr y))))
)
(foreach m lst1
(write-line
(strcat (rtos (car m) 2 3) "," (rtos (cadr m) 2 3))
f
)
)
(write-line "下⼀个" f)
)
(close f)
(princ)
)
[/code]