所有的点按照顺时针方向排序

hhh454

代码产生背景：
       在建筑模型绘图中，由于打灯光的需要，在建筑模型框架的内部需要做，万家灯火的框架，做成蜂窝状，每家窗户都有一个灯，模拟现实的灯光效果，通常是做成层层跑动的灯光，两路或者3路不同颜色变换的灯光，为了达到这种灯光效果，就需要CAD绘图员画出带灯孔的板和带凹槽的卡板，所以这个代码就出现了。对建筑模型行业了解的绘图员，都明白，灯孔板和卡板都是有规律的，所以用代码实现肯定能省不少时间，减少加班时间。
引用猫老师的话：“珍惜生命，提高工作效率”。
下图为：自动画万家灯火的灯孔板和带凹槽的卡板

代码的功能：点按照顺时针方向排序

1. (defun ssinters  (sss / i num obj1 obj2 j interpts ptlist)
   
2.   (setq  i   0
   
3.   num (sslength sss)
   
4.   )
   
5.   (while (< i (1- num))
   
6.     (setq obj1 (ssname sss i)
   
7.     obj1 (vlax-ename->vla-object obj1)
   
8.     j    (1+ i)
   
9.     )
   
10.     (while (< j num)
    
11.       (setq obj2     (ssname sss j)
    
12.       obj2     (vlax-ename->vla-object obj2)
    
13.       interpts (vla-intersectwith
    
14.            obj1
    
15.            obj2
    
16.            0
    
17.          )
    
18.       interpts (vlax-variant-value interpts)
    
19.       )
    
20.       (if (> (vlax-safearray-get-u-bound interpts 1) 0)
    
21.   (progn
    
22.     (setq  interpts
    
23.      (vlax-safearray->list interpts)
    
24.     )
    
25.     (while (> (length interpts) 0)
    
26.       (setq ptlist (cons (list (car interpts)
    
27.              (cadr interpts)
    
28.              (caddr interpts)
    
29.              )
    
30.              ptlist
    
31.        )
    
32.       )
    
33.       (setq interpts (cdddr interpts))
    
34.     )
    
35.   )
    
36.       )
    
37.       (setq j (1+ j))
    
38.     )
    
39.     (setq i (1+ i))
    
40.   )
    
41.   ptlist
    
42. )
    
43. 
    
44. 
    
45. (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N);By 自贡黄明儒
    
46.   ;;1 点列表排序
    
47.   (defun sortpts (PTS FUN xyz FUZZ)
    
48.     (vl-sort pts
    
49.       '(lambda (a b)
    
50.   (if (not (equal (xyz a) (xyz b) fuzz))
    
51.     (fun (xyz a) (xyz b))
    
52.   )
    
53.        )
    
54.     )
    
55.   )
    
56.   ;;2 排序先后
    
57.   (defun sortpts1 (PTS KEY FUZZ)
    
58.     (setq Key (vl-string->list Key))
    
59.     (foreach xyz (reverse Key)
    
60.       (cond ((< xyz 100)
    
61.       (setq fun >)
    
62.       (setq xyz (nth (- xyz 88) (list car cadr caddr)))
    
63.      )
    
64.      (T
    
65.       (setq fun <)
    
66.       (setq xyz (nth (- xyz 120) (list car cadr caddr)))
    
67.      )
    
68.       )
    
69.       (setq Pts (sortpts Pts fun xyz fuzz))
    
70.     )
    
71.   )
    
72.   ;;3 本程序主程序
    
73.   (cond
    
74.     ((= (type ssPts) 'PICKSET)
    
75.      (repeat (setq n (sslength ssPts))
    
76.        (if (and (setq e (ssname ssPts (setq n (1- n))))
    
77.   (setq en (entget e))
    
78.     )
    
79.   (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
    
80.        )
    
81.      )
    
82.      (mapcar 'last (sortpts1 lst KEY FUZZ))
    
83.     )
    
84.     ((Listp ssPts)
    
85.       (cond
    
86. ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
    
87. ((= (type (car ssPts)) 'ENAME)
    
88.   (foreach e ssPts
    
89.     (if (setq en (entget e))
    
90.       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
    
91.     )
    
92.   )
    
93.   (mapcar 'last (sortpts1 lst KEY FUZZ))
    
94. )
    
95. (T
    
96.   (cond ((equal key "X") (vl-sort ssPts '>))
    
97.         ((equal key "x") (vl-sort ssPts '<))
    
98.   )
    
99. )
    
100.       )
     
101.     )
     
102.   )
     
103. )
     
104. 
     
105. ;; Clockwise-p  -  Lee Mac
     
106. ;; Returns T if p1,p2,p3 are clockwise oriented
     
107. 
     
108. (defun LM:Clockwise-p ( p1 p2 p3 )
     
109.     ((lambda ( n ) (< (car (trans p2 0 n)) (car (trans p1 0 n)))) (mapcar '- p1 p3))
     
110. )
     
111. 
     
112. ;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
     
113. ;;示例(HH:PtLists (car (entsel)))
     
114. (defun HH:PtLists (en)
     
115.   (mapcar 'cdr
     
116.           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
     
117.   )
     
118. )
     
119. 
     
120. 
     
121. ;(/ osmode_bak clayer_bak ss ss7 ss2 en pts n);猫老师编辑器变量自动生成
     
122. (defun c:tt (/ osmode_bak clayer_bak ss ss7 ss2   p1 pts p2 p3 en n ss1  sss ptx lst pt)
     
123. ;----开始系统变量备份----
     
124. (command "undo" "be")
     
125. (setvar "cmdecho" 0);_关闭命令提示
     
126. (setq osmode_bak (getvar "osmode"));_记录捕捉
     
127. (setvar "osmode" 0);_关闭捕捉
     
128. (setq clayer_bak (getvar "clayer"));_记录当前图层
     
129. ;----;----;----;----;----;----;----;----;----
     
130. ;按照图层分选择集，为了求2个图层对象的交点
     
131. (setq ss (ssget))
     
132. 
     
133.   (command "select" ss  "")
     
134.   (setq ss7 (ssget "p" '((8 . "ngc7"))))
     
135. 
     
136.   (command "select" ss "")
     
137.   (setq ss2 (ssget "p" '((8 . "ngc2"))))
     
138. 
     
139. 
     
140. (setq en (ssname ss7 0))
     
141. (setq pts (HH:PtLists en));HH:PtLists多段线端点列表 By 自贡黄明儒
     
142. (setq n 0)
     
143. 
     
144. (if (< (fix(vlax-curve-getEndParam en)) 2)
     
145.     (progn
     
146.     (dengg);一条线的时候
     
147.   )
     
148. )
     
149. (if (> (fix(vlax-curve-getEndParam en)) 1)
     
150.     (progn
     
151.     (deng);多条线的时候
     
152.   )
     
153.   )
     
154. 
     
155. 
     
156. ;----结束系统变量还原----
     
157. (setvar "osmode" osmode_bak);_还原捕捉
     
158. (setvar "clayer" clayer_bak);_还原图层
     
159. (setvar "cmdecho" 1);_打开命令提示
     
160. (command "undo" "e")
     
161. (princ);_关闭程序返回值
     
162.   )
     
163. 
     
164. 
     
165. 
     
166. ;(/ p1 pts p2 p3 en n ss1 ss2 sss ptx lst pt)
     
167. (defun deng ()
     
168. (setq p1 (nth 0 pts)
     
169.       p2 (nth 1 pts)
     
170.       p3 (nth 2 pts)
     
171. )
     
172. (if (= (LM:Clockwise-p p1 p2 p3) nil); 判断顺时针和逆时针Clockwise-p  -  Lee Mac
     
173.     (progn (setq pts(reverse pts)))
     
174. )
     
175. ;重复动作
     
176. (repeat
     
177.    (fix(vlax-curve-getEndParam en))
     
178. (command "line" (nth n pts) (nth (1+ n) pts) "")
     
179. (setq ss1 (entlast))
     
180. (command "select" ss1 ss2 "")
     
181. (setq sss (ssget "p" ))
     
182. (setq ptx (ssinters sss));ssinters求交点，明经论坛里面的
     
183. (command "erase" ss1 "")
     
184. 
     
185. (setq lst (append (list  (nth n pts) (nth (1+ n) pts))  ptx))
     
186. ;下面就是判断线的方向，根据方向，重新排序点
     
187. (if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
     
188.         (< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
189.      )
     
190.    (progn(setq lst (HH:ssPts:Sort lst "y" 0.1)));点排序 HH:ssPts:Sort  By 自贡黄明儒
     
191. )
     
192. (if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
     
193.         (> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
194.      )
     
195.    (progn(setq lst (HH:ssPts:Sort lst "Y" 0.1)))
     
196. )
     
197. (if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
198.         (< (car(nth n pts)) (car(nth (1+ n) pts)))
     
199.      )
     
200.    (progn(setq lst (HH:ssPts:Sort lst "x" 0.1)))
     
201. )
     
202. (if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
203.         (> (car(nth n pts)) (car(nth (1+ n) pts)))
     
204.      )
     
205.    (progn(setq lst (HH:ssPts:Sort lst "X" 0.1)))
     
206. )
     
207. (if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
208.         (< (car(nth n pts)) (car(nth (1+ n) pts)))
     
209.      )
     
210.    (progn(setq lst (HH:ssPts:Sort lst "xy" 0.1)))
     
211. )
     
212. (if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
213.         (> (car(nth n pts)) (car(nth (1+ n) pts)))
     
214.      )
     
215.    (progn(setq lst (HH:ssPts:Sort lst "XY" 0.1)))
     
216. )
     
217. (if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
218.         (< (car(nth n pts)) (car(nth (1+ n) pts)))
     
219.      )
     
220.    (progn(setq lst (HH:ssPts:Sort lst "Yx" 0.1)))
     
221. )
     
222. (if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     
223.         (> (car(nth n pts)) (car(nth (1+ n) pts)))
     
224.      )
     
225.    (progn(setq lst (HH:ssPts:Sort lst "Xy" 0.1)))
     
226. )
     
227. 
     
228. (command "-layer" "s" "ngc1" "")
     
229. 
     
230. (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
     
231.       (mapcar '(lambda (pt)(cons 10 pt)) lst ))
     
232.   )
     
233.   (setq n (1+ n))
     
234. )
     
235. )

(defun ssinters  (sss / i num obj1 obj2 j interpts ptlist)<br />   (setq  i   0<br />   num (sslength sss)<br />   )<br />   (while (< i (1- num))<br />     (setq obj1 (ssname sss i)<br />     obj1 (vlax-ename->vla-object obj1)<br />     j    (1+ i)<br />     )<br />     (while (< j num)<br />       (setq obj2     (ssname sss j)<br />       obj2     (vlax-ename->vla-object obj2)<br />       interpts (vla-intersectwith<br />            obj1<br />            obj2<br />            0<br />          )<br />       interpts (vlax-variant-value interpts)<br />       )<br />       (if (> (vlax-safearray-get-u-bound interpts 1) 0)<br />   (progn<br />     (setq  interpts<br />      (vlax-safearray->list interpts)<br />     )<br />     (while (> (length interpts) 0)<br />       (setq ptlist (cons (list (car interpts)<br />              (cadr interpts)<br />              (caddr interpts)<br />              )<br />              ptlist<br />        )<br />       )<br />       (setq interpts (cdddr interpts))<br />     )<br />   )<br />       )<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   ptlist<br /> )<br /> <br /> <br /> (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N);By 自贡黄明儒<br />   ;;1 点列表排序<br />   (defun sortpts (PTS FUN xyz FUZZ)<br />     (vl-sort pts<br />       '(lambda (a b)<br />   (if (not (equal (xyz a) (xyz b) fuzz))<br />     (fun (xyz a) (xyz b))<br />   )<br />        )<br />     )<br />   )<br />   ;;2 排序先后<br />   (defun sortpts1 (PTS KEY FUZZ)<br />     (setq Key (vl-string->list Key))<br />     (foreach xyz (reverse Key)<br />       (cond ((< xyz 100)<br />       (setq fun >)<br />       (setq xyz (nth (- xyz 88) (list car cadr caddr)))<br />      )<br />      (T<br />       (setq fun <)<br />       (setq xyz (nth (- xyz 120) (list car cadr caddr)))<br />      )<br />       )<br />       (setq Pts (sortpts Pts fun xyz fuzz))<br />     )<br />   )<br />   ;;3 本程序主程序<br />   (cond<br />     ((= (type ssPts) 'PICKSET)<br />      (repeat (setq n (sslength ssPts))<br />        (if (and (setq e (ssname ssPts (setq n (1- n))))<br />   (setq en (entget e))<br />     )<br />   (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))<br />        )<br />      )<br />      (mapcar 'last (sortpts1 lst KEY FUZZ))<br />     )<br />     ((Listp ssPts)<br />       (cond<br /> ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))<br /> ((= (type (car ssPts)) 'ENAME)<br />   (foreach e ssPts<br />     (if (setq en (entget e))<br />       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))<br />     )<br />   )<br />   (mapcar 'last (sortpts1 lst KEY FUZZ))<br /> )<br /> (T<br />   (cond ((equal key "X") (vl-sort ssPts '>))<br />         ((equal key "x") (vl-sort ssPts '<))<br />   )<br /> )<br />       )<br />     )<br />   )<br /> )<br /> <br /> ;; Clockwise-p  -  Lee Mac<br /> ;; Returns T if p1,p2,p3 are clockwise oriented<br /> <br /> (defun LM:Clockwise-p ( p1 p2 p3 )<br />     ((lambda ( n ) (< (car (trans p2 0 n)) (car (trans p1 0 n)))) (mapcar '- p1 p3))<br /> )<br /> <br /> ;;164.3 [功能] 多段线端点列表 By 自贡黄明儒<br /> ;;示例(HH:PtLists (car (entsel)))<br /> (defun HH:PtLists (en)<br />   (mapcar 'cdr<br />           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))<br />   )<br /> )<br /> <br /> <br /> ;(/ osmode_bak clayer_bak ss ss7 ss2 en pts n);猫老师编辑器变量自动生成<br /> (defun c:tt (/ osmode_bak clayer_bak ss ss7 ss2   p1 pts p2 p3 en n ss1  sss ptx lst pt)<br /> ;----开始系统变量备份----<br /> (command "undo" "be")<br /> (setvar "cmdecho" 0);_关闭命令提示<br /> (setq osmode_bak (getvar "osmode"));_记录捕捉<br /> (setvar "osmode" 0);_关闭捕捉<br /> (setq clayer_bak (getvar "clayer"));_记录当前图层<br /> ;----;----;----;----;----;----;----;----;----<br /> ;按照图层分选择集，为了求2个图层对象的交点<br /> (setq ss (ssget))<br /> <br />   (command "select" ss  "")<br />   (setq ss7 (ssget "p" '((8 . "ngc7"))))<br /> <br />   (command "select" ss "")<br />   (setq ss2 (ssget "p" '((8 . "ngc2"))))<br /> <br /> <br /> (setq en (ssname ss7 0))<br /> (setq pts (HH:PtLists en));HH:PtLists多段线端点列表 By 自贡黄明儒<br /> (setq n 0)<br /> <br /> (if (< (fix(vlax-curve-getEndParam en)) 2)<br />     (progn<br />     (dengg);一条线的时候<br />   )<br /> )<br /> (if (> (fix(vlax-curve-getEndParam en)) 1)<br />     (progn<br />     (deng);多条线的时候<br />   )<br />   )<br /> <br /> <br /> ;----结束系统变量还原----<br /> (setvar "osmode" osmode_bak);_还原捕捉<br /> (setvar "clayer" clayer_bak);_还原图层<br /> (setvar "cmdecho" 1);_打开命令提示<br /> (command "undo" "e")<br /> (princ);_关闭程序返回值<br />   )<br /> <br /> <br /> <br /> ;(/ p1 pts p2 p3 en n ss1 ss2 sss ptx lst pt)<br /> (defun deng ()<br /> (setq p1 (nth 0 pts)<br />       p2 (nth 1 pts)<br />       p3 (nth 2 pts)<br /> )<br /> (if (= (LM:Clockwise-p p1 p2 p3) nil); 判断顺时针和逆时针Clockwise-p  -  Lee Mac<br />     (progn (setq pts(reverse pts)))<br /> )<br /> ;重复动作<br /> (repeat<br />    (fix(vlax-curve-getEndParam en))<br /> (command "line" (nth n pts) (nth (1+ n) pts) "")<br /> (setq ss1 (entlast))<br /> (command "select" ss1 ss2 "")<br /> (setq sss (ssget "p" ))<br /> (setq ptx (ssinters sss));ssinters求交点，明经论坛里面的<br /> (command "erase" ss1 "")<br /> <br /> (setq lst (append (list  (nth n pts) (nth (1+ n) pts))  ptx))<br /> ;下面就是判断线的方向，根据方向，重新排序点<br /> (if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))<br />         (< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "y" 0.1)));点排序 HH:ssPts:Sort  By 自贡黄明儒<br /> )<br /> (if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))<br />         (> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "Y" 0.1)))<br /> )<br /> (if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (< (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "x" 0.1)))<br /> )<br /> (if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (> (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "X" 0.1)))<br /> )<br /> (if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (< (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "xy" 0.1)))<br /> )<br /> (if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (> (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "XY" 0.1)))<br /> )<br /> (if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (< (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "Yx" 0.1)))<br /> )<br /> (if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))<br />         (> (car(nth n pts)) (car(nth (1+ n) pts)))<br />      )<br />    (progn(setq lst (HH:ssPts:Sort lst "Xy" 0.1)))<br /> )<br /> <br /> (command "-layer" "s" "ngc1" "")<br /> <br /> (entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))<br />       (mapcar '(lambda (pt)(cons 10 pt)) lst ))<br />   )<br />   (setq n (1+ n))<br /> )<br /> )

和上面的代码一样


希望能得到前辈的指点，上面就是判断线的方向的源代码，根据方向，重新排序点，应该有更加简单的办法，里面函数的出处我都标明了。

流氓兔

(defun ssinters  (sss / i num obj1 obj2 j interpts ptlist)
  (setq  i   0
  num (sslength sss)
  )
  (while (< i (1- num))
    (setq obj1 (ssname sss i)
    obj1 (vlax-ename->vla-object obj1)
    j    (1+ i)
    )
    (while (< j num)
      (setq obj2     (ssname sss j)
      obj2     (vlax-ename->vla-object obj2)
      interpts (vla-intersectwith
           obj1
           obj2
           0
         )
      interpts (vlax-variant-value interpts)
      )
      (if (> (vlax-safearray-get-u-bound interpts 1) 0)
  (progn
    (setq  interpts
     (vlax-safearray->list interpts)
    )
    (while (> (length interpts) 0)
      (setq ptlist (cons (list (car interpts)
             (cadr interpts)
             (caddr interpts)
             )
             ptlist
       )
      )
      (setq interpts (cdddr interpts))
    )
  )
      )
      (setq j (1+ j))
    )
    (setq i (1+ i))
  )
  ptlist
)


(defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N);By 自贡黄明儒
  ;;1 点列表排序
  (defun sortpts (PTS FUN xyz FUZZ)
    (vl-sort pts
      '(lambda (a b)
  (if (not (equal (xyz a) (xyz b) fuzz))
    (fun (xyz a) (xyz b))
  )
       )
    )
  )
  ;;2 排序先后
  (defun sortpts1 (PTS KEY FUZZ)
    (setq Key (vl-string->list Key))
    (foreach xyz (reverse Key)
      (cond ((< xyz 100)
      (setq fun >)
      (setq xyz (nth (- xyz 88) (list car cadr caddr)))
     )
     (T
      (setq fun <)
      (setq xyz (nth (- xyz 120) (list car cadr caddr)))
     )
      )
      (setq Pts (sortpts Pts fun xyz fuzz))
    )
  )
  ;;3 本程序主程序
  (cond
    ((= (type ssPts) 'PICKSET)
     (repeat (setq n (sslength ssPts))
       (if (and (setq e (ssname ssPts (setq n (1- n))))
  (setq en (entget e))
    )
  (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
       )
     )
     (mapcar 'last (sortpts1 lst KEY FUZZ))
    )
    ((Listp ssPts)
      (cond
((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
  (foreach e ssPts
    (if (setq en (entget e))
      (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
    )
  )
  (mapcar 'last (sortpts1 lst KEY FUZZ))
)
(T
  (cond ((equal key "X") (vl-sort ssPts '>))
        ((equal key "x") (vl-sort ssPts '<))
  )
)
      )
    )
  )
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:Clockwise-p ( p1 p2 p3 )
    ((lambda ( n ) (< (car (trans p2 0 n)) (car (trans p1 0 n)))) (mapcar '- p1 p3))
)

;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
;;示例(HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists (car (entsel)))
(defun HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists (en)
  (mapcar 'cdr
          (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
  )
)


;(/ osmode_bak clayer_bak ss ss7 ss2 en pts n);猫老师编辑器变量自动生成
(defun c:tt (/ osmode_bak clayer_bak ss ss7 ss2   p1 pts p2 p3 en n ss1  sss ptx lst pt)
;----开始系统变量备份----
(command "undo" "be")
(setvar "cmdecho" 0);_关闭命令提示
(setq osmode_bak (getvar "osmode"));_记录捕捉
(setvar "osmode" 0);_关闭捕捉
(setq clayer_bak (getvar "clayer"));_记录当前图层
;----;----;----;----;----;----;----;----;----
;按照图层分选择集，为了求2个图层对象的交点
(setq ss (ssget))

  (command "select" ss  "")
  (setq ss7 (ssget "p" '((8 . "ngc7"))))

  (command "select" ss "")
  (setq ss2 (ssget "p" '((8 . "ngc2"))))


(setq en (ssname ss7 0))
(setq pts (HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists en));HH<img src="static/image/smiley/default/tongue.gif" smilieid="7" border="0" alt="" />tLists多段线端点列表 By 自贡黄明儒
(setq n 0)

(if (< (fix(vlax-curve-getEndParam en)) 2)
    (progn
    (dengg);一条线的时候
  )
)
(if (> (fix(vlax-curve-getEndParam en)) 1)
    (progn
    (deng);多条线的时候
  )
  )


;----结束系统变量还原----
(setvar "osmode" osmode_bak);_还原捕捉
(setvar "clayer" clayer_bak);_还原图层
(setvar "cmdecho" 1);_打开命令提示
(command "undo" "e")
(princ);_关闭程序返回值
  )



;(/ p1 pts p2 p3 en n ss1 ss2 sss ptx lst pt)
(defun deng ()
(setq p1 (nth 0 pts)
      p2 (nth 1 pts)
      p3 (nth 2 pts)
)
(if (= (LM:Clockwise-p p1 p2 p3) nil); 判断顺时针和逆时针Clockwise-p  -  Lee Mac
    (progn (setq pts(reverse pts)))
)
;重复动作
(repeat
   (fix(vlax-curve-getEndParam en))
(command "line" (nth n pts) (nth (1+ n) pts) "")
(setq ss1 (entlast))
(command "select" ss1 ss2 "")
(setq sss (ssget "p" ))
(setq ptx (ssinters sss));ssinters求交点，明经论坛里面的
(command "erase" ss1 "")

(setq lst (append (list  (nth n pts) (nth (1+ n) pts))  ptx))
;下面就是判断线的方向，根据方向，重新排序点
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
        (< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "y" 0.1)));点排序 HH:ssPts:Sort  By 自贡黄明儒
)
(if (and(= (car(nth n pts)) (car(nth (1+ n) pts)))
        (> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "Y" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (< (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "x" 0.1)))
)
(if (and(= (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (> (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "X" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (< (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "xy" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (> (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "XY" 0.1)))
)
(if (and(> (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (< (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "Yx" 0.1)))
)
(if (and(< (cadr(nth n pts)) (cadr(nth (1+ n) pts)))
        (> (car(nth n pts)) (car(nth (1+ n) pts)))
     )
   (progn(setq lst (HH:ssPts:Sort lst "Xy" 0.1)))
)

(command "-layer" "s" "ngc1" "")

(entmake (append    (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
      (mapcar '(lambda (pt)(cons 10 pt)) lst ))
  )
  (setq n (1+ n))
)
)



好东西

yxh1202

流氓兔 发表于 2021-3-25 21:54
(defun ssinters  (sss / i num obj1 obj2 j interpts ptlist)
  (setq  i   0
  num (sslength sss)

请问老师，这个是按线顺序排点吗。

hhh454

我自己做的工具箱，已经发布在论坛的工具篇
春婵建筑模型CAD绘图工具箱
http://bbs.mjtd.com/forum.php?mo ... &fromuid=363233
(出处: 明经CAD社区)

yxl88168

楼主厉害啊，

999999

顶起顶起，，，，期待楼主的更新

vladimir

非常好的代码，谢谢分享啊。

LIULISHENG

找了好长时间终于找到了

hhh454

LIULISHENG 发表于 2021-4-25 17:20
找了好长时间终于找到了

还能有好多的拓展代码

xj6019

咋没看明白咋回事呢，是只能判断多段线吗