【Gu_xl】[讨论]根据选择的直线·、圆弧等实体，自动生成有实体围成的所有边界

Gu_xl

2. 
   
3. ;;;La为图层名
   
4. (defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel)
   
5. ;;;===============================
   
6. ;;;表操作函数
   
7. ;;;判断点 p1 是否在点集PL中，是返回T ，不是返回nil，a为精度
   
8. ;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T
   
9. (defun IsInPointList (p1 PL a)
   
10. ;(setq n (length PL))
    
11. (if (member t (mapcar '(lambda (b) (equal p1 b a)) PL))
    
12. t
    
13. nil
    
14. )
    
15. )
    
16. ;;;取出图元索引i对应的值
    
17. (defun dxf (ent i)
    
18. (cdr (assoc i (entget ent)))
    
19. )
    
20. ;;;取圆弧的起点、终点。中点
    
21. (defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)
    
22. (setq cenp (cdr (assoc 10 (entget a))))
    
23. (setq radius (cdr (assoc 40 (entget a))))
    
24. (setq STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A)))
    
25. (setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))
    
26. (setq arcmidpoint (polar (polar stp (angle stp enp) (/ (distance STP ENP) 2.0))
    
27. (angle cenp (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)))
    
28. (- radius (distance (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) cenp))))
    
29. (list stp enp arcmidpoint)
    
30. )
    
31. 
    
32. 
    
33. ;;;根据选择集中的line、arc、circle，生成点集
    
34. (defun make_point_list (s / PL)
    
35. (setq n 0 PL '() mn (sslength s))
    
36. (repeat mn
    
37. (setq en (ssname s n)
    
38. enType (dxf en 0))
    
39. (cond
    
40. ((= enType "LINE")
    
41. (setq pt1 (dxf en 10)
    
42. pt2 (dxf en 11))
    
43. (if (not (IsInPointList pt1 pl 0.00001))
    
44. (setq pl (cons pt1 pl))
    
45. );if
    
46. (if (not (IsInPointList pt2 pl 0.00001))
    
47. (setq pl (cons pt2 pl))
    
48. );if
    
49. )
    
50. ((= enType "ARC")
    
51. (setq pt1 (car (arc_3point en))
    
52. pt2 (cadr (arc_3point en))
    
53. )
    
54. (if (not (IsInPointList pt1 pl 0.00001))
    
55. (setq pl (cons pt1 pl))
    
56. );if
    
57. (if (not (IsInPointList pt2 pl 0.00001))
    
58. (setq pl (cons pt2 pl))
    
59. );if
    
60. 
    
61. )
    
62. 
    
63. );cond
    
64. (setq n (1+ n))
    
65. );repeat
    
66. (setq pl pl)
    
67. );make_point_list
    
68. ;;;此处SEL选择集可自行修改为命令行选择代码
    
69. (setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))
    
70. (if sel
    
71. (progn
    
72. (setq Plist (make_point_list sel))
    
73. (setq enlast (entlast) ensel (ssadd))
    
74. (setvar "CLAYER" la)
    
75. (command "_.boundary" "a" "b" "n" sel "" "" )
    
76. (setq n -1
    
77. mn 0
    
78. k (length Plist))
    
79. (repeat k
    
80. (setq p0 (nth (setq n (1+ n)) Plist) mn n)
    
81. (repeat (- k n 1)
    
82. (setq p1 (nth (setq mn (1+ mn)) Plist))
    
83. (setq p2 (midpoint p0 p1))
    
84. (command p2)
    
85. );repeat
    
86. );repeat
    
87. (command "")
    
88. (while (setq en (entnext enlast))
    
89. (setq enlast en)
    
90. (ssadd en ensel)
    
91. );while
    
92. (command "erase" sel "")
    
93. (setq ensel ensel)
    
94. );progn
    
95. nil
    
96. );if
    
97. )   
    

<br /> ;;;La为图层名<br /> (defun Layer_zdsb (La / sel make_point_list n mn en entype pt1 pt2 pL sel k p1 p2 enlast ensel)<br /> ;;;===============================<br /> ;;;表操作函数<br /> ;;;判断点 p1 是否在点集PL中，是返回T ，不是返回nil，a为精度<br /> ;;;例 (IsInPointList '(1.0001 1.001 0) '((1 1 0) (2 1 0)) 0.001),返回T<br /> (defun IsInPointList (p1 PL a)<br /> ;(setq n (length PL))<br /> (if (member t (mapcar '(lambda (b) (equal p1 b a)) PL))<br /> t<br /> nil<br /> )<br /> )<br /> ;;;取出图元索引i对应的值<br /> (defun dxf (ent i)<br /> (cdr (assoc i (entget ent)))<br /> )<br /> ;;;取圆弧的起点、终点。中点<br /> (defun arc_3point (a / cenp radius STP ENPmp arcmidpoint)<br /> (setq cenp (cdr (assoc 10 (entget a))))<br /> (setq radius (cdr (assoc 40 (entget a))))<br /> (setq STP (vlax-curve-getPointAtParam A (vlax-curve-getstartparam A)))<br /> (setq ENP (vlax-curve-getPointAtParam A (vlax-curve-getEndParam A)))<br /> (setq arcmidpoint (polar (polar stp (angle stp enp) (/ (distance STP ENP) 2.0))<br /> (angle cenp (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)))<br /> (- radius (distance (polar stp (angle stp enp) (/ (distance STP ENP) 2.0)) cenp))))<br /> (list stp enp arcmidpoint)<br /> )<br /> <br /> <br /> ;;;根据选择集中的line、arc、circle，生成点集<br /> (defun make_point_list (s / PL)<br /> (setq n 0 PL '() mn (sslength s))<br /> (repeat mn<br /> (setq en (ssname s n)<br /> enType (dxf en 0))<br /> (cond<br /> ((= enType "LINE")<br /> (setq pt1 (dxf en 10)<br /> pt2 (dxf en 11))<br /> (if (not (IsInPointList pt1 pl 0.00001))<br /> (setq pl (cons pt1 pl))<br /> );if<br /> (if (not (IsInPointList pt2 pl 0.00001))<br /> (setq pl (cons pt2 pl))<br /> );if<br /> )<br /> ((= enType "ARC")<br /> (setq pt1 (car (arc_3point en))<br /> pt2 (cadr (arc_3point en))<br /> )<br /> (if (not (IsInPointList pt1 pl 0.00001))<br /> (setq pl (cons pt1 pl))<br /> );if<br /> (if (not (IsInPointList pt2 pl 0.00001))<br /> (setq pl (cons pt2 pl))<br /> );if<br /> <br /> )<br /> <br /> );cond<br /> (setq n (1+ n))<br /> );repeat<br /> (setq pl pl)<br /> );make_point_list<br /> ;;;此处SEL选择集可自行修改为命令行选择代码<br /> (setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))<br /> (if sel<br /> (progn<br /> (setq Plist (make_point_list sel))<br /> (setq enlast (entlast) ensel (ssadd))<br /> (setvar "CLAYER" la)<br /> (command "_.boundary" "a" "b" "n" sel "" "" )<br /> (setq n -1<br /> mn 0<br /> k (length Plist))<br /> (repeat k<br /> (setq p0 (nth (setq n (1+ n)) Plist) mn n)<br /> (repeat (- k n 1)<br /> (setq p1 (nth (setq mn (1+ mn)) Plist))<br /> (setq p2 (midpoint p0 p1))<br /> (command p2)<br /> );repeat<br /> );repeat<br /> (command "")<br /> (while (setq en (entnext enlast))<br /> (setq enlast en)<br /> (ssadd en ensel)<br /> );while<br /> (command "erase" sel "")<br /> (setq ensel ensel)<br /> );progn<br /> nil<br /> );if<br /> )   <br />

程序缺点是选择的实体多了，计算速度太慢，请高手讨论，提供共好的算法！
程序加以改进后，完整代码如下：

游客，本帖隐藏的内容需要发帖数高于 10 才可浏览，你当前发帖数只有 0

zhd81617

谢谢作者

xiaocaiji

Gu_xl 发表于 2010-2-6 18:52
不好意思，该处代码有误，已修改((= enType "ARC")(setq pt1 (car (arc_3point en))pt2 (cadr (arc_3point  ...

学习下，谢谢

pickstar

xuexi                     

liu_kunlun

用手工选择限制选择实体的范围

(setq sel (ssget "x" (list '(0 . "line,arc,circle") (cons 8 La))))

改为：(setq sel (ssget (list '(0 . "line,arc,circle") (cons 8 La))))

yoyoho

Gu_xl 你好:

程序对圆弧是不是有问题啊!

如果仅选择线是O.K.

如果选择含有圆弧时,有错误讯息!

ERROR:损坏的引数类型: lentityp nilosnap
目前的物件锁点模式: 端点,中点,中心点,交点
输入物件锁点模式的清单: endp,mid,int,cen

Gu_xl

Gu_xl 你好:

程序对圆弧是不是有问题啊!

如果仅选择线是O.K.

如果选择含有圆弧时,有错误讯息!

ERROR:损坏的引数类型: lentityp nilosnap
目前的物件锁点模式: 端点,中点,中心点,交点
输入物件锁点模式的清单: endp,mid,int,cen

 

不好意思，该处代码有误，已修改

((= enType "ARC")
(setq pt1 (car (arc_3point en))
pt2 (cadr (arc_3point en))
)

yoyoho

Gu_xl你好:

依照你的方式修正程序,

程序运行O.K.

感谢你的帮忙!

461045462

收藏了，下来学习
谢谢楼主的分享

xiaxiang

感谢分享，gu_xl

mandala

这个东西厉害。感谢版主分享。

xhq1954425

下来备用，谢谢分享！

qcw911

好程序，下载收藏!