选择异常飞时达方格-飞时达方格分割后产生的BUG

树櫴希德

2. 
   
3. (defun trans2dda (ename / AcadObject AcadDocument mSpace ent_data str_0 obj pts sngSArea)
   
4.   (VL-LOAD-COM)
   
5.   
   
6.   (setq AcadObject (vlax-get-acad-object))
   
7.   (setq AcadDocument (vla-get-ActiveDocument Acadobject))
   
8.   (setq mSpace (vla-get-ModelSpace Acaddocument))
   
9. 
   
10.   ;(setq ename (car (entsel "选择要转换的三维多段线:")))
    
11.   (setq ent_data (entget ename))
    
12.   (setq str_0 (cdr (assoc 0 ent_data)))
    
13.   (while (/= str_0 "POLYLINE")
    
14.     (setq ename (car (entsel "选择的实体非三维多段线,请重新选择!:")))
    
15.     (setq ent_data (entget ename))
    
16.     (setq str_0 (cdr (assoc 0 ent_data)))
    
17.    )
    
18.       (setq obj (vlax-ename->vla-object ename))
    
19.       (setq pts (vlax-variant-value (vla-get-coordinates obj)))
    
20.       
    
21.   ;(vlax-ename->vla-object (vla-AddPolyline mSpace pts) )
    
22.   ;(setq vlaSTrigon (vlax-ename->vla-object objSTrigon));将转化成VLA 对象
    
23. 
    
24.      (setq sngSArea (vlax-curve-getArea  (vla-AddPolyline mSpace pts) ))
    
25. 
    
26.   (entdel (entlast))
    
27.       ;(princ)
    
28.      sngSArea
    
29. )
    
30. 
    
31. (defun xyp-CurveLength (s1) (vlax-curve-getDistAtParam s1 (vlax-curve-getEndParam s1)))
    
32. ;;;;;;;;;;;;;;;;;;;;;;;;;
    
33. (defun c:xzfgw ( / ss fgmj ee i sss fgzc)  ;飞时达异常方格删除
    
34. 
    
35. (setq fgmj (getreal "\n请输入方格面积5位小数如25.00000：") )
    
36.   (setq fgzc (getreal "\n请输入方格周长5位小数如20.00000：") )
    
37. ;(setq fgmj (trans2dda (car (entsel "\n请选择样板方格："))) )
    
38. 
    
39.   
    
40. (setq ss (ssget '( (0 . "polyline")  (8 . "tf-fg1")  ))
    
41.           i  0
    
42.     )
    
43.   (setq sss (ssadd))
    
44.     (while (setq ee (ssname ss i))
    
45.       
    
46.       (if (or (> (-(xyp-CurveLength ee) 0.001) fgzc) (> (- (trans2dda ee) 0.001) fgmj)      )
    
47.       (progn  (ssadd ee sss)   )
    
48.       )
    
49.       
    
50.       (setq i (1+ i))
    
51.     )
    
52.   (sssetfirst nil sss)
    
53.   
    
54.   
    
55. 
    
56. 
    
57. 
    
58. 
    
59. )

<br /> (defun trans2dda (ename / AcadObject AcadDocument mSpace ent_data str_0 obj pts sngSArea)<br />   (VL-LOAD-COM)<br />   <br />   (setq AcadObject (vlax-get-acad-object))<br />   (setq AcadDocument (vla-get-ActiveDocument Acadobject))<br />   (setq mSpace (vla-get-ModelSpace Acaddocument))<br /> <br />   ;(setq ename (car (entsel "选择要转换的三维多段线:")))<br />   (setq ent_data (entget ename))<br />   (setq str_0 (cdr (assoc 0 ent_data)))<br />   (while (/= str_0 "POLYLINE")<br />     (setq ename (car (entsel "选择的实体非三维多段线,请重新选择!:")))<br />     (setq ent_data (entget ename))<br />     (setq str_0 (cdr (assoc 0 ent_data)))<br />    )<br />       (setq obj (vlax-ename->vla-object ename))<br />       (setq pts (vlax-variant-value (vla-get-coordinates obj)))<br />       <br />   ;(vlax-ename->vla-object (vla-AddPolyline mSpace pts) )<br />   ;(setq vlaSTrigon (vlax-ename->vla-object objSTrigon));将转化成VLA 对象<br /> <br />      (setq sngSArea (vlax-curve-getArea  (vla-AddPolyline mSpace pts) ))<br /> <br />   (entdel (entlast))<br />       ;(princ)<br />      sngSArea<br /> )<br /> <br /> (defun xyp-CurveLength (s1) (vlax-curve-getDistAtParam s1 (vlax-curve-getEndParam s1)))<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun c:xzfgw ( / ss fgmj ee i sss fgzc)  ;飞时达异常方格删除<br /> <br /> (setq fgmj (getreal "\n请输入方格面积5位小数如25.00000：") )<br />   (setq fgzc (getreal "\n请输入方格周长5位小数如20.00000：") )<br /> ;(setq fgmj (trans2dda (car (entsel "\n请选择样板方格："))) )<br /> <br />   <br /> (setq ss (ssget '( (0 . "polyline")  (8 . "tf-fg1")  ))<br />           i  0<br />     )<br />   (setq sss (ssadd))<br />     (while (setq ee (ssname ss i))<br />       <br />       (if (or (> (-(xyp-CurveLength ee) 0.001) fgzc) (> (- (trans2dda ee) 0.001) fgmj)      )<br />       (progn  (ssadd ee sss)   )<br />       )<br />       <br />       (setq i (1+ i))<br />     )<br />   (sssetfirst nil sss)<br />   <br />   <br /> <br /> <br /> <br /> <br /> )

updoc

飞时达用来算量还是好用的，就是D版不好找。