[LISP函数]：取复线中一点,不用面域判断法现已经完善!

舟自横

2. 
   
3. (defun hy_polyinp(polys / poly1 p1 p2 anglep1 anglep2 line dist1 needpoint
   
4.                          pointlist basedis nedis shpoint yourpoint line frontpoint
   
5.                           backpoint)
   
6.   ;;;;;;;;;;;;取封閉復線內一點..........已完善.......
   
7.   (setvar "osmode" 0)
   
8.   (command "udo" "be")
   
9.   (command "ucs" "w")
   
10.   (setq key 0)
    
11.   (hy_polyinp_1 polys)
    
12.   (if (and frontpoint backpoint)
    
13.       (progn
    
14.       (setq angle1 (angle needpoint frontpoint)
    
15.             angle2 (angle needpoint backpoint))
    
16.       (while (or (equal angle1 anglep1 0.00001)
    
17.               (equal angle2 anglep1 0.00001))
    
18.               (vla-delete (vlax-ename->vla-object line))
    
19.                      (command "._rotate" polys "" '(0 0 0) 15.0)
    
20.                      (hy_polyinp_1 polys)
    
21.                      (setq key (1+ key))
    
22.                 )
    
23.       )
    
24.     );;;;;;;;;判斷是否有角度與BOX對角一致如果一致轉過15度重新計算
    
25.   (foreach item (hy_interpoint line polys)
    
26.     (if (equal needpoint item 0.00001)
    
27.       (setq pointlist(vl-remove item (hy_interpoint line polys)))
    
28.       )
    
29.     )
    
30.   (setq basedis (distance needpoint (nth 0 pointlist)))
    
31.   (foreach item pointlist
    
32.     (if (<= (setq nedis (distance needpoint item)) basedis)
    
33.         (progn (setq basedis nedis)
    
34.                (setq shpoint item))
    
35.       )
    
36.     )
    
37.   (setq yourpoint (list (/ (+ (car needpoint) (car shpoint)) 2)
    
38.                         (/ (+ (cadr needpoint) (cadr shpoint)) 2)
    
39.                         0)
    
40.         )
    
41.   (vla-delete (vlax-ename->vla-object line))
    
42.   (if (/= 0 key) (progn (command "._rotate" polys "" '(0 0 0) (* key -15.0))
    
43.           (setq yourpoint (polar '(0 0 0) (- (angle '(0 0 0) yourpoint)
    
44.                                               (* (/ (* key 15.0) 180) pi))
    
45.                                  (distance '(0 0 0) yourpoint)
    
46.                                  )
    
47.                 ))
    
48.     )
    
49.   (command "undo" "e")
    
50.   yourpoint
    
51.   )
    
52. (defun hy_polyinp_1(poly / poly1 io)
    
53.   (setq poly1 (vlax-ename->vla-object poly))
    
54.   (vla-getboundingbox poly1 'p1 'p2)
    
55.   (setq p1 (vlax-safearray->list p1)
    
56.         p2 (vlax-safearray->list p2)
    
57.         anglep1 (angle p1 p2)
    
58.         anglep2 (angle p2 p1)
    
59.         p1 (polar p1 anglep2 5)
    
60.         p2 (polar p2 anglep1 5))
    
61.   (command "line" p1 p2 "")(setq line (entlast))
    
62.   (command "trim" poly "" (list line p1) "")
    
63.   (setq line (entlast))
    
64.   (setq dist1 (vla-get-length (vlax-ename->vla-object line)))
    
65.   (setq needpoint (polar p2 anglep2 dist1))
    
66.   (setq io 0)
    
67.   (setq ptlist (hy_polpoint poly))
    
68.   (setq frontpoint nil backpoint nil)
    
69.   (repeat (length ptlist)
    
70.     (if (equal needpoint (hy_2d->3d(nth io ptlist)) 0.00001)
    
71.         (if (and (/= io 0) (/= io (1- (length ptlist))))
    
72.         (setq frontpoint (hy_2d->3d(nth (1- io) ptlist))
    
73.               backpoint (hy_2d->3d(nth (1+ io) ptlist))
    
74.               )
    
75.             (progn (if (= io 0)
    
76.               (setq frontpoint (hy_2d->3d(last ptlist))
    
77.               backpoint (hy_2d->3d(nth (1+ io) ptlist))
    
78.               ))
    
79.               (if (= io (1- (length ptlist)))
    
80.               (setq frontpoint (hy_2d->3d(nth (1- io) ptlist))
    
81.               backpoint (hy_2d->3d(car ptlist))
    
82.               ))
    
83.               )
    
84.           )
    
85.       )
    
86.       (setq io (1+ io))
    
87.       );;;判斷needpoint是否是復線的一個頂點如果是求得前后點的坐標
    
88.   )
    
89. (defun hy_2d->3d(point)
    
90.   (vlax-safearray->list
    
91.     (vlax-variant-value
    
92.       (vlax-3d-point point))
    
93.     )
    
94.   )
    
95. 
    
96. (defun hy_interpoint(object1 object2 / jdtb);;返回兩圖元交點
    
97. (vl-load-com)
    
98. (setq jdtb (vla-intersectwith (vlax-ename->vla-object object1) (vlax-ename->vla-object object2) acExtendnone))
    
99. (setq jdtb (vlax-safearray->list (vlax-variant-value jdtb)))
    
100. (hy_ocom jdtb 3)
     
101. )
     
102. (defun hy_polpoint(object / endata i endata_li)
     
103.   (setq point_list '())
     
104.   (setq endata (entget object))
     
105.   (setq i 0)
     
106.   (while (< i (length endata))
     
107.     (setq endata_li (nth i endata))
     
108.     (if (= (car endata_li) 10) (setq point_list (cons (cdr endata_li) point_list)))
     
109.     (setq i (1+ i))
     
110.     )
     
111.   (setq point_list (reverse point_list))
     
112.   )
     
113. (defun hy_ocom(totlist num / needlist shuldlist numer stay);;處理數據列表分組每一組為NUM個,余項也為組
     
114.                                                            ;;FOR EXCAMPLE: (hy_ocom '(-64.4309 100.541 0.0 -106.992 144.345 0.0 1 2) 3)
     
115.                                                            ;;return : ((-106.992 144.345 0.0) (-64.4309 100.541 0.0) (1 2))
     
116.   (setq needlist totlist)
     
117.   (setq shuldlist nil)
     
118.   (if (> (length totlist) num)
     
119.     (progn
     
120.     (setq stay (rem (length totlist) num))
     
121.     (setq numer (/ (- (length totlist) stay) num))
     
122.     (repeat numer
     
123.       (setq shuldlist (cons (hy_ijlist needlist 0 num) shuldlist))
     
124.       (setq needlist (hy_ijlist needlist (- num 1) nil))
     
125.     )
     
126.     (setq shuldlist (reverse shuldlist))
     
127.     (if (/= stay 0) (setq remlist (reverse(hy_ijlist (reverse totlist) 0 stay))
     
128.                           shuldlist (append shuldlist (list remlist))))
     
129.     shuldlist
     
130.     )
     
131.     nil)
     
132.   )
     
133. (defun hy_ijlist(lst i j);;;取得列表從i開始以后j數量的片段表如果j為nil則取出i以后的列表從0開始
     
134.   (setq aplist '())
     
135.   (if (= j nil)
     
136.       (repeat (+ i 1)
     
137.       (setq lst (cdr lst))
     
138.       (setq aplist lst))
     
139.       (progn
     
140.       (repeat j
     
141.       (setq aplist (cons (nth i lst) aplist))
     
142.         (setq i (1+ i))
     
143.         )
     
144.       (setq aplist (reverse aplist))
     
145.       )
     
146.     )
     
147.   aplist
     
148.   )
     

<br /> (defun hy_polyinp(polys / poly1 p1 p2 anglep1 anglep2 line dist1 needpoint<br />                          pointlist basedis nedis shpoint yourpoint line frontpoint<br />                           backpoint)<br />   ;;;;;;;;;;;;取封閉復線內一點..........已完善.......<br />   (setvar "osmode" 0)<br />   (command "udo" "be")<br />   (command "ucs" "w")<br />   (setq key 0)<br />   (hy_polyinp_1 polys)<br />   (if (and frontpoint backpoint)<br />       (progn<br />       (setq angle1 (angle needpoint frontpoint)<br />             angle2 (angle needpoint backpoint))<br />       (while (or (equal angle1 anglep1 0.00001)<br />               (equal angle2 anglep1 0.00001))<br />               (vla-delete (vlax-ename->vla-object line))<br />                      (command "._rotate" polys "" '(0 0 0) 15.0)<br />                      (hy_polyinp_1 polys)<br />                      (setq key (1+ key))<br />                 )<br />       )<br />     );;;;;;;;;判斷是否有角度與BOX對角一致如果一致轉過15度重新計算<br />   (foreach item (hy_interpoint line polys)<br />     (if (equal needpoint item 0.00001)<br />       (setq pointlist(vl-remove item (hy_interpoint line polys)))<br />       )<br />     )<br />   (setq basedis (distance needpoint (nth 0 pointlist)))<br />   (foreach item pointlist<br />     (if (<= (setq nedis (distance needpoint item)) basedis)<br />         (progn (setq basedis nedis)<br />                (setq shpoint item))<br />       )<br />     )<br />   (setq yourpoint (list (/ (+ (car needpoint) (car shpoint)) 2)<br />                         (/ (+ (cadr needpoint) (cadr shpoint)) 2)<br />                         0)<br />         )<br />   (vla-delete (vlax-ename->vla-object line))<br />   (if (/= 0 key) (progn (command "._rotate" polys "" '(0 0 0) (* key -15.0))<br />           (setq yourpoint (polar '(0 0 0) (- (angle '(0 0 0) yourpoint)<br />                                               (* (/ (* key 15.0) 180) pi))<br />                                  (distance '(0 0 0) yourpoint)<br />                                  )<br />                 ))<br />     )<br />   (command "undo" "e")<br />   yourpoint<br />   )<br /> (defun hy_polyinp_1(poly / poly1 io)<br />   (setq poly1 (vlax-ename->vla-object poly))<br />   (vla-getboundingbox poly1 'p1 'p2)<br />   (setq p1 (vlax-safearray->list p1)<br />         p2 (vlax-safearray->list p2)<br />         anglep1 (angle p1 p2)<br />         anglep2 (angle p2 p1)<br />         p1 (polar p1 anglep2 5)<br />         p2 (polar p2 anglep1 5))<br />   (command "line" p1 p2 "")(setq line (entlast))<br />   (command "trim" poly "" (list line p1) "")<br />   (setq line (entlast))<br />   (setq dist1 (vla-get-length (vlax-ename->vla-object line)))<br />   (setq needpoint (polar p2 anglep2 dist1))<br />   (setq io 0)<br />   (setq ptlist (hy_polpoint poly))<br />   (setq frontpoint nil backpoint nil)<br />   (repeat (length ptlist)<br />     (if (equal needpoint (hy_2d->3d(nth io ptlist)) 0.00001)<br />         (if (and (/= io 0) (/= io (1- (length ptlist))))<br />         (setq frontpoint (hy_2d->3d(nth (1- io) ptlist))<br />               backpoint (hy_2d->3d(nth (1+ io) ptlist))<br />               )<br />             (progn (if (= io 0)<br />               (setq frontpoint (hy_2d->3d(last ptlist))<br />               backpoint (hy_2d->3d(nth (1+ io) ptlist))<br />               ))<br />               (if (= io (1- (length ptlist)))<br />               (setq frontpoint (hy_2d->3d(nth (1- io) ptlist))<br />               backpoint (hy_2d->3d(car ptlist))<br />               ))<br />               )<br />           )<br />       )<br />       (setq io (1+ io))<br />       );;;判斷needpoint是否是復線的一個頂點如果是求得前后點的坐標<br />   )<br /> (defun hy_2d->3d(point)<br />   (vlax-safearray->list<br />     (vlax-variant-value<br />       (vlax-3d-point point))<br />     )<br />   )<br /> <br /> (defun hy_interpoint(object1 object2 / jdtb);;返回兩圖元交點<br /> (vl-load-com)<br /> (setq jdtb (vla-intersectwith (vlax-ename->vla-object object1) (vlax-ename->vla-object object2) acExtendnone))<br /> (setq jdtb (vlax-safearray->list (vlax-variant-value jdtb)))<br /> (hy_ocom jdtb 3)<br /> )<br /> (defun hy_polpoint(object / endata i endata_li)<br />   (setq point_list '())<br />   (setq endata (entget object))<br />   (setq i 0)<br />   (while (< i (length endata))<br />     (setq endata_li (nth i endata))<br />     (if (= (car endata_li) 10) (setq point_list (cons (cdr endata_li) point_list)))<br />     (setq i (1+ i))<br />     )<br />   (setq point_list (reverse point_list))<br />   )<br /> (defun hy_ocom(totlist num / needlist shuldlist numer stay);;處理數據列表分組每一組為NUM個,余項也為組<br />                                                            ;;FOR EXCAMPLE: (hy_ocom '(-64.4309 100.541 0.0 -106.992 144.345 0.0 1 2) 3)<br />                                                            ;;return : ((-106.992 144.345 0.0) (-64.4309 100.541 0.0) (1 2))<br />   (setq needlist totlist)<br />   (setq shuldlist nil)<br />   (if (> (length totlist) num)<br />     (progn<br />     (setq stay (rem (length totlist) num))<br />     (setq numer (/ (- (length totlist) stay) num))<br />     (repeat numer<br />       (setq shuldlist (cons (hy_ijlist needlist 0 num) shuldlist))<br />       (setq needlist (hy_ijlist needlist (- num 1) nil))<br />     )<br />     (setq shuldlist (reverse shuldlist))<br />     (if (/= stay 0) (setq remlist (reverse(hy_ijlist (reverse totlist) 0 stay))<br />                           shuldlist (append shuldlist (list remlist))))<br />     shuldlist<br />     )<br />     nil)<br />   )<br /> (defun hy_ijlist(lst i j);;;取得列表從i開始以后j數量的片段表如果j為nil則取出i以后的列表從0開始<br />   (setq aplist '())<br />   (if (= j nil)<br />       (repeat (+ i 1)<br />       (setq lst (cdr lst))<br />       (setq aplist lst))<br />       (progn <br />       (repeat j<br />       (setq aplist (cons (nth i lst) aplist))<br />         (setq i (1+ i))<br />         )<br />       (setq aplist (reverse aplist))<br />       )<br />     )<br />   aplist<br />   )<br />

现已经弥补了以前程序的一个BUG,取出点空间较大
如果用旧方法取得的点和复线边太近执行时容易产生
错误,现在问题已经解决....执行(hy_polyinp (car(entsel)))
返回内部点坐标值!!

狂刀

舟兄在贴程序的时候
在内容前后加　［code］ .....［/code］ 或 ［php］...［/php］（使用中换为小写）
看起来会更好

舟自横

谢谢提醒!THANKS!!