拟合的POLYLINE转SPLINE

newer

1. (defun c:2ndss2spls ( / *error* arc2spl line2spl loop sss i ent ssss )
   
2. 
   
3.   (vl-load-com)
   
4. 
   
5.   (defun *error* ( msg )
   
6.     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   
7.     (if msg (prompt msg))
   
8.     (princ)
   
9.   )
   
10. 
    
11.   (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )
    
12. 
    
13.            (setq q1 (vlax-curve-GetStartParam e)
    
14.                  q2 (vlax-curve-GetEndParam e)
    
15.                  a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle
    
16.                  pc (mapcar                              ; pc - points on contur
    
17.                       (function
    
18.                         (lambda (p)
    
19.                          (vlax-curve-GetPointAtParam e p)
    
20.                           )
    
21.                         )
    
22.                       (list q1 (+ q1 a) (- q2 a) q2)
    
23.                     )
    
24.                  f  (mapcar                               ; f - first deriv on pc
    
25.                       (function
    
26.                         (lambda (p)
    
27.                           (vlax-curve-GetFirstDeriv e p)
    
28.                           )
    
29.                         )
    
30.                       (list q1 (+ q1 a) (- q2 a) q2)
    
31.                     )
    
32.                  pe (mapcar                              ; pe - extra control points for spline construction
    
33.                       (function
    
34.                         (lambda (p1 p2 d1 d2)
    
35.                           (inters p1 (mapcar '+ p1 d1)
    
36.                                   p2 (mapcar '+ p2 d2)
    
37.                                   nil
    
38.                                   )
    
39.                         )
    
40.                       )
    
41.                      pc (cdr pc) f (cdr f)
    
42.                     )
    
43.                  ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline
    
44.                  w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
    
45.            )
    
46. 
    
47.     (defun make_spline ( pts )
    
48.       (entmakex
    
49.         (append
    
50.            '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
    
51.               (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
    
52.               (42 . 1.0e-010) (43 . 1.0e-010)
    
53.               (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
    
54.               (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
    
55.            pts
    
56.         )
    
57.       )
    
58.     )
    
59. 
    
60. 
    
61. 
    
62.     (entdel e)
    
63.     (make_spline (points ps w))
    
64. 
    
65.   )
    
66. 
    
67.   (defun line2spl ( e / sp ep d )
    
68. 
    
69.     (setq sp (cdr (assoc 10 (entget e)))
    
70.           ep (cdr (assoc 11 (entget e)))
    
71.           d (distance sp ep)
    
72.     )
    
73. 
    
74.     (entdel e)
    
75. 
    
76.     (entmakex
    
77.       (list
    
78.         '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
    
79.         '(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)
    
80.       )
    
81.     )
    
82. 
    
83.   )
    
84. 
    
85.   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
    
86.   (setq loop T)
    
87.   (setq sss (ssget "_I"))
    
88.   (if
    
89.     (and
    
90.       sss
    
91.       (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))
    
92.     )
    
93.     (setq loop nil)
    
94.   )
    
95.   (while loop
    
96.     (setq sss (ssget "_:L" (list '(-4 . "<or") '(0 . "LINE,ARC,LWPOLYLINE") '(-4 . "<and") '(0 . "POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 8) '(70 . 9) '(70 . 128) '(70 . 129) '(-4 . "or>") '(-4 . "and>") '(-4 . "or>"))))
    
97.     (if sss (setq loop nil))
    
98.   )
    
99.   (setq ssss (ssadd))
    
100.   (repeat (setq i (sslength sss))
     
101.     (setq ent (ssname sss (setq i (1- i))))
     
102.     (cond
     
103.       ( (eq (cdr (assoc 0 (entget ent))) "LINE")
     
104.         (line2spl ent)
     
105.         (ssadd (entlast) ssss)
     
106.       )
     
107.       ( (eq (cdr (assoc 0 (entget ent))) "ARC")
     
108.         (arc2spl ent)
     
109.         (ssadd (entlast) ssss)
     
110.       )
     
111.       ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
     
112.         (sssetfirst nil (ssadd ent))
     
113.         (c:lw2spl)
     
114.         (ssadd (entlast) ssss)
     
115.         (sssetfirst nil nil)
     
116.       )
     
117.       ( (and
     
118.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
     
119.           (or
     
120.             (eq (cdr (assoc 70 (entget ent))) 0)
     
121.             (eq (cdr (assoc 70 (entget ent))) 1)
     
122.             (eq (cdr (assoc 70 (entget ent))) 128)
     
123.             (eq (cdr (assoc 70 (entget ent))) 129)
     
124.           )
     
125.         )
     
126.         (command "_.CONVERTPOLY" "_L" ent)
     
127.         (while (> (getvar 'cmdactive) 0) (command ""))
     
128.         (sssetfirst nil (ssadd ent))
     
129.         (c:lw2spl)
     
130.         (ssadd (entlast) ssss)
     
131.         (sssetfirst nil nil)
     
132.       )
     
133.       ( (and
     
134.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
     
135.           (or
     
136.             (eq (cdr (assoc 70 (entget ent))) 8)
     
137.             (eq (cdr (assoc 70 (entget ent))) 9)
     
138.           )
     
139.         )
     
140.         (sssetfirst nil (ssadd ent))
     
141.         (c:3p2spl)
     
142.         (ssadd (entlast) ssss)
     
143.         (sssetfirst nil nil)
     
144.       )
     
145.     )
     
146.   )
     
147.   (sssetfirst nil ssss)
     
148.   (*error* nil)
     
149. )
     
150. 
     
151. (defun c:oldheavyfit2spl ( / *error* *adoc* ss pl sp e sss )
     
152. 
     
153.   (vl-load-com)
     
154. 
     
155.   (defun *error* ( m )
     
156.     (vla-endundomark *adoc*)
     
157.     (if m
     
158.       (prompt m)
     
159.     )
     
160.     (princ)
     
161.   )
     
162. 
     
163.   (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
     
164.   (prompt "\nPick old heavy 2d polyline that is curve fited...")
     
165.   (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(-4 . "<or") '(70 . 2) '(70 . 3) '(70 . 130) '(70 . 131) '(-4 . "or>"))))
     
166.   (if ss
     
167.     (progn
     
168.       (setq pl (ssname ss 0))
     
169.       (setq sp (vlax-curve-getstartpoint pl))
     
170.       (command "_.EXPLODE" pl)
     
171.       (while (< 0 (getvar 'cmdactive))
     
172.         (command "")
     
173.       )
     
174.       (sssetfirst nil (ssget "_P"))
     
175.       (c:2ndss2spls)
     
176.       (setq sss (cadr (ssgetfirst)))
     
177.       (setq e (car (nentselp (trans sp 0 1))))
     
178.       (command "_.JOIN" e sss "")
     
179.     )
     
180.   )
     
181.   (*error* nil)
     
182. )
     

(defun c:2ndss2spls ( / *error* arc2spl line2spl loop sss i ent ssss )<br /> <br />   (vl-load-com)<br /> <br />   (defun *error* ( msg )<br />     (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br />     (if msg (prompt msg))<br />     (princ)<br />   )<br /> <br />   (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )<br /> <br />            (setq q1 (vlax-curve-GetStartParam e)<br />                  q2 (vlax-curve-GetEndParam e)<br />                  a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle<br />                  pc (mapcar                              ; pc - points on contur<br />                       (function<br />                         (lambda (p)<br />                          (vlax-curve-GetPointAtParam e p)<br />                           )<br />                         )<br />                       (list q1 (+ q1 a) (- q2 a) q2)<br />                     )<br />                  f  (mapcar                               ; f - first deriv on pc<br />                       (function<br />                         (lambda (p)<br />                           (vlax-curve-GetFirstDeriv e p)<br />                           )<br />                         )<br />                       (list q1 (+ q1 a) (- q2 a) q2)<br />                     )<br />                  pe (mapcar                              ; pe - extra control points for spline construction<br />                       (function<br />                         (lambda (p1 p2 d1 d2)<br />                           (inters p1 (mapcar '+ p1 d1)<br />                                   p2 (mapcar '+ p2 d2)<br />                                   nil<br />                                   )<br />                         )<br />                       )<br />                      pc (cdr pc) f (cdr f)<br />                     )<br />                  ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline<br />                  w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline<br />            )<br /> <br />     (defun make_spline ( pts )<br />       (entmakex<br />         (append<br />            '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")<br />               (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)<br />               (42 . 1.0e-010) (43 . 1.0e-010)<br />               (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)<br />               (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))<br />            pts<br />         )<br />       )<br />     )<br /> <br /> <br /> <br />     (entdel e)<br />     (make_spline (points ps w))<br /> <br />   )<br /> <br />   (defun line2spl ( e / sp ep d )<br /> <br />     (setq sp (cdr (assoc 10 (entget e)))<br />           ep (cdr (assoc 11 (entget e)))<br />           d (distance sp ep)<br />     )<br /> <br />     (entdel e)<br /> <br />     (entmakex<br />       (list<br />         '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)<br />         '(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)<br />       )<br />     )<br /> <br />   )<br /> <br />   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  <br />   (setq loop T)<br />   (setq sss (ssget "_I"))<br />   (if <br />     (and <br />       sss <br />       (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))<br />     )<br />     (setq loop nil)<br />   )<br />   (while loop<br />     (setq sss (ssget "_:L" (list '(-4 . "<or") '(0 . "LINE,ARC,LWPOLYLINE") '(-4 . "<and") '(0 . "POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 8) '(70 . 9) '(70 . 128) '(70 . 129) '(-4 . "or>") '(-4 . "and>") '(-4 . "or>"))))<br />     (if sss (setq loop nil))<br />   )<br />   (setq ssss (ssadd))<br />   (repeat (setq i (sslength sss))<br />     (setq ent (ssname sss (setq i (1- i))))<br />     (cond<br />       ( (eq (cdr (assoc 0 (entget ent))) "LINE")<br />         (line2spl ent)<br />         (ssadd (entlast) ssss)<br />       )<br />       ( (eq (cdr (assoc 0 (entget ent))) "ARC")<br />         (arc2spl ent)<br />         (ssadd (entlast) ssss)<br />       )<br />       ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")<br />         (sssetfirst nil (ssadd ent))<br />         (c:lw2spl)<br />         (ssadd (entlast) ssss)<br />         (sssetfirst nil nil)<br />       )<br />       ( (and<br />           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")<br />           (or<br />             (eq (cdr (assoc 70 (entget ent))) 0)<br />             (eq (cdr (assoc 70 (entget ent))) 1)<br />             (eq (cdr (assoc 70 (entget ent))) 128)<br />             (eq (cdr (assoc 70 (entget ent))) 129)<br />           )<br />         )<br />         (command "_.CONVERTPOLY" "_L" ent)<br />         (while (> (getvar 'cmdactive) 0) (command ""))<br />         (sssetfirst nil (ssadd ent))<br />         (c:lw2spl)<br />         (ssadd (entlast) ssss)<br />         (sssetfirst nil nil)<br />       )<br />       ( (and<br />           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")<br />           (or<br />             (eq (cdr (assoc 70 (entget ent))) 8)<br />             (eq (cdr (assoc 70 (entget ent))) 9)<br />           )<br />         )<br />         (sssetfirst nil (ssadd ent))<br />         (c:3p2spl)<br />         (ssadd (entlast) ssss)<br />         (sssetfirst nil nil)<br />       )<br />     )<br />   )<br />   (sssetfirst nil ssss)<br />   (*error* nil)<br /> )<br /> <br /> (defun c:oldheavyfit2spl ( / *error* *adoc* ss pl sp e sss )<br /> <br />   (vl-load-com)<br /> <br />   (defun *error* ( m )<br />     (vla-endundomark *adoc*)<br />     (if m<br />       (prompt m)<br />     )<br />     (princ)<br />   )<br /> <br />   (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))<br />   (prompt "\nPick old heavy 2d polyline that is curve fited...")<br />   (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(-4 . "<or") '(70 . 2) '(70 . 3) '(70 . 130) '(70 . 131) '(-4 . "or>"))))<br />   (if ss<br />     (progn<br />       (setq pl (ssname ss 0))<br />       (setq sp (vlax-curve-getstartpoint pl))<br />       (command "_.EXPLODE" pl)<br />       (while (< 0 (getvar 'cmdactive))<br />         (command "")<br />       )<br />       (sssetfirst nil (ssget "_P"))<br />       (c:2ndss2spls)<br />       (setq sss (cadr (ssgetfirst)))<br />       (setq e (car (nentselp (trans sp 0 1))))<br />       (command "_.JOIN" e sss "")<br />     )<br />   )<br />   (*error* nil)<br /> )<br />

函数 points ：

游客，如果您要查看本帖隐藏内容请回复

/db_自贡黄明儒_

听说爆破一下就可以了，不知道是不是真的。很难遇到POLYLINE线，也无法验证

newer

/db_自贡黄明儒_ 发表于 2017-7-14 13:14

自己画个2D POLYLINE不就验证了,你说的爆破一下是做什么？ 变SPLINE ？

ynhh

感谢版主的分享
谢谢

q3_2006

我以为是反过来..样条转多段线

waterchen

好程序，謝謝分享！

zixuan203344

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

yoyoho

实用程序谢谢分享！！！

laiz3000

回复看看

crtrccrt

做好事业务的一样

434939575

进来学习哈，谢谢！

819534890

回复学习，谢谢分享

HLCAD

感谢自主分享程序

960322

不会吧，还可以这样

pezyl

多数是spline转polyline，这个牛逼谢谢分享