(XD::Polyline:IsRectang)判断Pline是否构成矩形

st788796

1. (defun XD::Polyline:IsRectang (e / nums)
   
2.   (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline")
   
3.        (not (xdrx_polyline_hasbulges e))
   
4.        (xdrx_polyline_compress e t)
   
5.        (or (= (setq nums (xdrx_polyline_numverts e)) 4) (= nums 5))
   
6.        (equal (car (xdrx_getarea e))
   
7.               (* (apply 'distance (xdrx_polyline_getlinesegat e 0))
   
8.                  (apply 'distance (xdrx_polyline_getlinesegat e 3))
   
9.               )
   
10.               1e-6
    
11.        )
    
12.   )
    
13. )
    

(defun XD::Polyline:IsRectang (e / nums)<br />   (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline")<br />        (not (xdrx_polyline_hasbulges e))<br />        (xdrx_polyline_compress e t)<br />        (or (= (setq nums (xdrx_polyline_numverts e)) 4) (= nums 5))<br />        (equal (car (xdrx_getarea e))<br />               (* (apply 'distance (xdrx_polyline_getlinesegat e 0))<br />                  (apply 'distance (xdrx_polyline_getlinesegat e 3))<br />               )<br />               1e-6<br />        )<br />   )<br /> )<br />

牢固

执行此函数判断后，原多段线被精简了！最好保持原多段线不变，拷贝一个副本来判断，或者多给一个参数让用户来决定是否要精简原多段线！

st788796

牢固 发表于 2013-11-19 12:58
执行此函数判断后，原多段线被精简了！最好保持原多段线不变，拷贝一个副本来判断，或者多给一个参数让用户 ...

用 SearchOutline 就可以不整理原曲线了

st788796

另一个不改变原Polyline的

1. (defun XD::Polyline:IsRectang (e / pts p1 p2 p3 p4)
   
2.   (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline")
   
3.        (setq pts (xdrx_geom_searchoutline e))
   
4.        (= (length pts) 5)
   
5.        (mapcar 'set '(p1 p2 p3 p4) pts)
   
6.        (equal (distance p1 p3) (distance p2 p4) 1e-8)
   
7.        (equal (xdrx_line_midp p1 p3) (xdrx_line_midp p2 p4) 1e-8)
   
8.   )
   
9. )
   

(defun XD::Polyline:IsRectang (e / pts p1 p2 p3 p4)<br />   (and (= (xdrx_getpropertyvalue e "IsA") "AcDbPolyline")<br />        (setq pts (xdrx_geom_searchoutline e))<br />        (= (length pts) 5)<br />        (mapcar 'set '(p1 p2 p3 p4) pts)<br />        (equal (distance p1 p3) (distance p2 p4) 1e-8)<br />        (equal (xdrx_line_midp p1 p3) (xdrx_line_midp p2 p4) 1e-8)<br />   )<br /> )<br />

熊掌设计

    不错.~~~~~~~~~~~~~~~~~~~~支持.
感谢分享

wangxf888

学习  实用的程序