[求助]由多线段组成的闭合图形,求取组成闭合图形的多线段的句柄
www.dimcax.com
[求助]由多线段组成的闭合图形,求取组成闭合图形的多线段的句柄
(vl-load-com)
(defun c:test ()
(princ "\n选取*pline多义线...")
(setq ss (ssget '((0 . "lwpolyline")))
i -1
ptlst '()
)
(setq f (getfiled "写出文件" "" "txt" 1))
(setq f (open f "w"))
(if ss
(progn
(while (setq ssn (ssname ss (setq i (1+ i))))
(setq retcoord (vlax-ename->vla-object ssn)
)
(setq px (cdr (assoc 10 (entget ssn))))
(setq py (cdr (assoc 10 (reverse(entget ssn)))))
(setq handle (cdr(assoc 5 (entget ssn))))
(setq pt (list px py handle))
(setq ptlst (cons pt ptlst))
)
(princ "\n多义线顶点坐标集(!ptlst) : ")
(if ptlst
(princ ptlst)
)
)
(princ "\n未选到多义线!")
)
(princ)
;;;判断坐标
;;(while ptlst
(setq outlst '())
(setq obj1 (car ptlst))
(setq obj1_f (car obj1))
(setq obj1_e (cadr obj1))
(setq pptlst (cdr ptlst))
(setq outlst (caddr obj1))
;;初步判断
(if(equal obj1_f obj1_e 0.1)
(write-line (vl-princ-to-string outlst) f)
(princ "完整闭合区域!")
)
(while pptlst nil
(setq obj2 (car pptlst)
pptlst (cdr pptlst)
obj2_f (car obj2)
obj2_e (cadr obj2)
han (caddr obj2)
j 0)
;;;比较
(if(equal obj1_e obj2_f 0.1)
(setq obj1_e obj2_e
outlst (cons han outlst)
pptlst (vl-remove (nth j pptlst) pptlst))
(write-line (vl-princ-to-string outlst) f)
)
(if(equal obj1_e obj2_e 0.1)
(setq obj1_e obj2_f
outlst (cons han outlst)
pptlst (vl-remove (nth j pptlst) pptlst))
(write-line (vl-princ-to-string outlst) f)
)
(if(equal obj1_f obj1_e 0.1)
(princ "yid")
)
(princ "\n")
)
)
在执行时只能输出两个句柄,不能输出全部。
望各位帮忙啊,谢谢各位了,等急用!
d