随机高程--明经论坛各位大神函数，感谢

不做伸手党

怎么联系下啊

跑了一下午

spp_wall 发表于 2015-9-16 22:03
作用是？作假么

应该是为了图面更好看

树櫴希德

1. ;;框选范围内交点插入图块  By Gu_xl 2011.04
   
2. 
   
3. ;;;计算曲线交点
   
4. 
   
5. (defun Curveinters (en1 en2 / pl pts)
   
6. 
   
7.   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
   
8. 
   
9.   (while pl
   
10. 
    
11.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
    
12. 
    
13.    pl (cdr (cdr (cdr pl)))
    
14. 
    
15.    )
    
16. 
    
17.     )
    
18. 
    
19. pts
    
20. 
    
21.   )
    
22. 
    
23. ;;;曲线选择集交点
    
24. 
    
25. (defun ssinters (ss / pts en1 en2)
    
26. 
    
27.   (while (> (sslength ss) 1)
    
28. 
    
29.     (setq en1 (ssname ss 0))
    
30. 
    
31.     (ssdel en1 ss)
    
32. 
    
33.     (setq n (sslength ss))
    
34. 
    
35.     (repeat n
    
36. 
    
37.       (setq en2 (ssname ss (setq n (1- n))))
    
38. 
    
39.       (setq pts (append pts (Curveinters en1 en2)))
    
40. 
    
41.       )
    
42. 
    
43.     )
    
44. 
    
45.   pts
    
46. 
    
47.   )
    
48. 
    
49. 
    
50. 
    
51. 
    
52. 
    
53. ;;;实例: 按选择范围框内插入图块
    
54. 
    
55. (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )
    
56. 
    
57.   (setq os (getvar "osmode"))
    
58. 
    
59.   (setq cmdecho (getvar "cmdecho"))
    
60. 
    
61.   (setvar "osmode" 0)
    
62. 
    
63.   (setvar "cmdecho" 0)
    
64. 
    
65.   (setq blockname (getstring  "\n插入块名称:"))
    
66. 
    
67.   (if (null d) (setq d 1.))
    
68. 
    
69.   (while (and
    
70. 
    
71.            (setq p1 (getpoint "\n选择插入范围左下角："))
    
72. 
    
73.            (setq p2 (GETCORNER p1 "\n选择插入范围左下角："))
    
74. 
    
75.            )
    
76. 
    
77.     (setq minX (apply 'min (mapcar 'car (list p1 p2)))
    
78. 
    
79.           minY (apply 'min (mapcar 'cadr (list p1 p2)))
    
80. 
    
81.           maxX (apply 'max (mapcar 'car (list p1 p2)))
    
82. 
    
83.           maxY (apply 'max (mapcar 'cadr (list p1 p2)))
    
84. 
    
85.           )
    
86. 
    
87.     (grvecs (list 1 (list minx miny) (list maxx miny)
    
88. 
    
89.                   1 (list maxx miny) (list maxx maxy)
    
90. 
    
91.                   1 (list maxx maxy) (list minx maxy)
    
92. 
    
93.                   1 (list minx maxy) (list minx miny)
    
94. 
    
95.                   )
    
96. 
    
97.             )
    
98. 
    
99.     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))
    
100. 
     
101.     (if ss
     
102. 
     
103.       (progn
     
104. 
     
105.         (setq pts (ssinters ss))
     
106. 
     
107.         (if pts
     
108. 
     
109.           (foreach pt pts
     
110. 
     
111.             (if (and (>= maxX (car pt) minX)
     
112. 
     
113.                      (>= maxY (cadr pt) minY)
     
114. 
     
115.                      )
     
116. 
     
117.               ;;插入图块
     
118. 
     
119.               (command "insert" blockname "_non" pt 1 1 0)
     
120. 
     
121.               )
     
122. 
     
123.             )
     
124. 
     
125.           )
     
126. 
     
127.         )
     
128. 
     
129.       )
     
130. 
     
131.     (princ "\n ***回车键结束***")
     
132. 
     
133.     )
     
134. 
     
135. (setvar "osmode" os)
     
136. 
     
137.   (setvar "cmdecho" cmdecho)
     
138. 
     
139.   (princ)
     
140. 
     
141.   )
     

;;框选范围内交点插入图块  By Gu_xl 2011.04<br /> <br /> ;;;计算曲线交点<br /> <br /> (defun Curveinters (en1 en2 / pl pts)<br /> <br />   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))<br /> <br />   (while pl<br /> <br />     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))<br /> <br />    pl (cdr (cdr (cdr pl)))<br /> <br />    )<br /> <br />     )<br /> <br /> pts<br /> <br />   )<br /> <br /> ;;;曲线选择集交点<br /> <br /> (defun ssinters (ss / pts en1 en2)<br /> <br />   (while (> (sslength ss) 1)<br /> <br />     (setq en1 (ssname ss 0))<br /> <br />     (ssdel en1 ss)<br /> <br />     (setq n (sslength ss))<br /> <br />     (repeat n<br /> <br />       (setq en2 (ssname ss (setq n (1- n))))<br /> <br />       (setq pts (append pts (Curveinters en1 en2)))<br /> <br />       )<br /> <br />     )<br /> <br />   pts<br /> <br />   )<br /> <br /> <br /> <br /> <br /> <br /> ;;;实例: 按选择范围框内插入图块<br /> <br /> (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho blockname )<br /> <br />   (setq os (getvar "osmode"))<br /> <br />   (setq cmdecho (getvar "cmdecho"))<br /> <br />   (setvar "osmode" 0)<br /> <br />   (setvar "cmdecho" 0)<br /> <br />   (setq blockname (getstring  "\n插入块名称:"))<br /> <br />   (if (null d) (setq d 1.))<br /> <br />   (while (and<br /> <br />            (setq p1 (getpoint "\n选择插入范围左下角："))<br /> <br />            (setq p2 (GETCORNER p1 "\n选择插入范围左下角："))<br /> <br />            )<br /> <br />     (setq minX (apply 'min (mapcar 'car (list p1 p2)))<br /> <br />           minY (apply 'min (mapcar 'cadr (list p1 p2)))<br /> <br />           maxX (apply 'max (mapcar 'car (list p1 p2)))<br /> <br />           maxY (apply 'max (mapcar 'cadr (list p1 p2)))<br /> <br />           )<br /> <br />     (grvecs (list 1 (list minx miny) (list maxx miny)<br /> <br />                   1 (list maxx miny) (list maxx maxy)<br /> <br />                   1 (list maxx maxy) (list minx maxy)<br /> <br />                   1 (list minx maxy) (list minx miny)<br /> <br />                   )<br /> <br />             )<br /> <br />     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))<br /> <br />     (if ss<br /> <br />       (progn<br /> <br />         (setq pts (ssinters ss))<br /> <br />         (if pts<br /> <br />           (foreach pt pts<br /> <br />             (if (and (>= maxX (car pt) minX)<br /> <br />                      (>= maxY (cadr pt) minY)<br /> <br />                      )<br /> <br />               ;;插入图块<br /> <br />               (command "insert" blockname "_non" pt 1 1 0)<br /> <br />               )<br /> <br />             )<br /> <br />           )<br /> <br />         )<br /> <br />       )<br /> <br />     (princ "\n ***回车键结束***")<br /> <br />     )<br /> <br /> (setvar "osmode" os)<br /> <br />   (setvar "cmdecho" cmdecho)<br /> <br />   (princ)<br /> <br />   )<br />

tigcat

spp_wall 发表于 2015-9-16 22:03
作用是？作假么

仅为lisp学习！