几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量

几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量 (http://www.dimcax.com/hust/index.php)
-   ObjectARX(AutoLISP) (http://www.dimcax.com/hust/forumdisplay.php?f=178)
-   -   [求助]由多线段组成的闭合图形,求取组成闭合图形的多线段的句柄 (http://www.dimcax.com/hust/showthread.php?t=11251)

yang686526 2009-04-26 02:15 PM

[求助]由多线段组成的闭合图形,求取组成闭合图形的多线段的句柄
 
[求助]由多线段组成的闭合图形,求取组成闭合图形的多线段的句柄
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


所有的时间均为北京时间。 现在的时间是 11:32 AM.