Topic: - = { Challenge } = - convert curve fit old 2d heavy pline to spline

[ribarm]

Like it's written in the title... Only the challenge is consisted in the fact that I don't want to use CVREBUILD command... I want it to be done in any other way and I want the result to be as possible as equal to reference polyline... Let's see if someone can do it...

BTW. I know this isn't possible, but who knows...

M.R.

[kdub_nz]

< .. >... Let's see if someone can do it...

BTW. I know this isn't possible, but who knows...

M.R.

Are you offering a prize as inducement and incentive ??

[ribarm]

< .. >... Let's see if someone can do it...

BTW. I know this isn't possible, but who knows...

M.R.

Are you offering a prize as inducement and incentive ??

I was just trying to awake inspiration in someone that follows the topic... Of course I don't have prize, it's just informative, to see if someone is willing to share something I or maybe other have missed...

[ribarm]

Here is what I've got, but it's applicable only if simple cases (no self intersecting, or newly programmed LINE do not cross pline) :

Code - Auto/Visual Lisp: [Select]

1. (defun c:oldheavyfit2spl ( / *error* *adoc* ss pl sp ep li e )
2.  
3.   (vl-load-com)
4.  
5.   (defun *error* ( m )
6.     (vla-endundomark *adoc*)
7.     (if m
8.       (prompt m)
9.     )
10.     (princ)
11.   )
12.  
13.   (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
14.   (prompt "\nPick old heavy 2d polyline that is curve fited...")
15.   (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(-4 . "<or") '(70 . 2) '(70 . 3) '(70 . 130) '(70 . 131) '(-4 . "or>"))))
16.   (if ss
17.     (if (or (= (cdr (assoc 70 (entget (setq pl (ssname ss 0))))) 2) (= (cdr (assoc 70 (entget (setq pl (ssname ss 0))))) 130))
18.       (progn
19.         (setq sp (vlax-curve-getstartpoint pl))
20.         (setq ep (vlax-curve-getendpoint pl))
21.         (setq li (entmakex (list '(0 . "LINE") (cons 10 sp) (cons 11 ep))))
22.         (command "_.REGION" (ssadd li ss) "")
23.         (command "_.CONVTOSURFACE" (entlast) "")
24.         (command "_.CONVTONURBS" (entlast) "")
25.         (setq e (entlast))
26.         (command "_.OFFSETEDGE" "_non" sp "_D" "0.0")
27.         (while (< 0 (getvar 'cmdactive))
28.           (command "")
29.         )
30.         (entdel e)
31.         (command "_.BREAK" (entlast) "_non" sp "_non" ep)
32.         (command "_.JOIN" "_non" sp "_non" ep "")
33.       )
34.       (progn
35.         (setq sp (vlax-curve-getstartpoint pl))
36.         (command "_.REGION" ss "")
37.         (command "_.CONVTOSURFACE" (entlast) "")
38.         (command "_.CONVTONURBS" (entlast) "")
39.         (setq e (entlast))
40.         (command "_.OFFSETEDGE" "_non" sp "_D" "0.0")
41.         (while (< 0 (getvar 'cmdactive))
42.           (command "")
43.         )
44.         (entdel e)
45.       )
46.     )
47.   )
48.   (*error* nil)
49. )
50.  

I am looking forward to see if someone can do it better for every case...
Regards, M.R.

[Stefan]

Marko, as a guy who doesn't want to use a built-in command, you are using a lot of (command....

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / m2p a b e f1 f2 i k m p p1 p2 v w)
2.   (defun m2p (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.0)) a b))
3.   (if
4.     (setq e (car (entsel)))
5.     (progn
6.       (setq i (fix (vlax-curve-getendparam e))
7.             k (list i)
8.             )
9.       (repeat i
10.         (setq p1 (vlax-curve-getpointatparam e i)
11.               f1 (vlax-curve-getfirstderiv e i)
12.               m  (vlax-curve-getpointatparam e (- i 0.5))
13.               k  (append (list i i) k)
14.               p2 (vlax-curve-getpointatparam e (setq i (1- i)))
15.               f2 (vlax-curve-getfirstderiv e i)
16.               v  (inters p1 (mapcar '+ p1 f1)
17.                          p2 (mapcar '+ p2 f2)
18.                          nil
19.                          )
20.               p  (append (list v p1) p)
21.               w  (append (list (/ (distance (m2p p1 p2) m) (distance m v)) 1.0) w)
22.               )
23.         )
24.       (setq k (append '(0.0 0.0 0.0) k)
25.             p (cons p2 p)
26.             w (cons 1.0 w)
27.             )
28.       (entmake
29.         (append
30.           (list
31.             '(0 . "SPLINE")
32.             '(100 . "AcDbEntity")
33.             '(100 . "AcDbSpline")
34.             '(70 . 12)
35.             '(71 . 2)
36.             (cons 72 (length k))
37.             (cons 73 (length p))
38.             '(74 . 0)
39.             '(42 . 1.0e-010)
40.             '(43 . 1.0e-010)
41.           )
42.           (mapcar '(lambda (k) (cons 40 k)) k)
43.           (apply 'append
44.             (mapcar
45.               '(lambda (p w)
46.                  (list (cons 10 p) (cons 41 w))
47.                )
48.               p w
49.             )
50.           )
51.         )
52.       )
53.     )
54.   )
55.   (princ)
56. )

[ronjonp]

Stefan,

The code above errors for me at (distance m v) because 'v' returns nil.

[ribarm]

Stefan, I like your version, but it has lacks... See attached DWG... Here is my second attempt and yes, it's again using (command ...) calls, but it works to me till now and I had no problems...

Code - Auto/Visual Lisp: [Select]

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.     (defun points ( p w )
61.       (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
62.     )
63.  
64.     (entdel e)
65.     (make_spline (points ps w))
66.    
67.   )
68.  
69.   (defun line2spl ( e / sp ep d )
70.  
71.     (setq sp (cdr (assoc 10 (entget e)))
72.           ep (cdr (assoc 11 (entget e)))
73.           d (distance sp ep)
74.     )
75.  
76.     (entdel e)
77.  
78.     (entmakex
79.       (list
80.         '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
81.         '(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)
82.       )
83.     )
84.    
85.   )
86.  
87.   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
88.   (setq loop T)
89.   (setq sss (ssget "_I"))
90.   (if
91.     (and
92.       sss
93.       (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))
94.     )
95.     (setq loop nil)
96.   )
97.   (while loop
98.     (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>"))))
99.     (if sss (setq loop nil))
100.   )
101.   (setq ssss (ssadd))
102.   (repeat (setq i (sslength sss))
103.     (setq ent (ssname sss (setq i (1- i))))
104.     (cond
105.       ( (eq (cdr (assoc 0 (entget ent))) "LINE")
106.         (line2spl ent)
107.         (ssadd (entlast) ssss)
108.       )
109.       ( (eq (cdr (assoc 0 (entget ent))) "ARC")
110.         (arc2spl ent)
111.         (ssadd (entlast) ssss)
112.       )
113.       ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
114.         (sssetfirst nil (ssadd ent))
115.         (c:lw2spl)
116.         (ssadd (entlast) ssss)
117.         (sssetfirst nil nil)
118.       )
119.       ( (and
120.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
121.           (or
122.             (eq (cdr (assoc 70 (entget ent))) 0)
123.             (eq (cdr (assoc 70 (entget ent))) 1)
124.             (eq (cdr (assoc 70 (entget ent))) 128)
125.             (eq (cdr (assoc 70 (entget ent))) 129)
126.           )
127.         )
128.         (command "_.CONVERTPOLY" "_L" ent)
129.         (while (> (getvar 'cmdactive) 0) (command ""))
130.         (sssetfirst nil (ssadd ent))
131.         (c:lw2spl)
132.         (ssadd (entlast) ssss)
133.         (sssetfirst nil nil)
134.       )
135.       ( (and
136.           (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
137.           (or
138.             (eq (cdr (assoc 70 (entget ent))) 8)
139.             (eq (cdr (assoc 70 (entget ent))) 9)
140.           )
141.         )
142.         (sssetfirst nil (ssadd ent))
143.         (c:3p2spl)
144.         (ssadd (entlast) ssss)
145.         (sssetfirst nil nil)
146.       )
147.     )
148.   )
149.   (sssetfirst nil ssss)
150.   (*error* nil)
151. )
152.  
153. (defun c:oldheavyfit2spl ( / *error* *adoc* ss pl sp e sss )
154.  
155.   (vl-load-com)
156.  
157.   (defun *error* ( m )
158.     (vla-endundomark *adoc*)
159.     (if m
160.       (prompt m)
161.     )
162.     (princ)
163.   )
164.  
165.   (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
166.   (prompt "\nPick old heavy 2d polyline that is curve fited...")
167.   (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(-4 . "<or") '(70 . 2) '(70 . 3) '(70 . 130) '(70 . 131) '(-4 . "or>"))))
168.   (if ss
169.     (progn
170.       (setq pl (ssname ss 0))
171.       (setq sp (vlax-curve-getstartpoint pl))
172.       (command "_.EXPLODE" pl)
173.       (while (< 0 (getvar 'cmdactive))
174.         (command "")
175.       )
176.       (sssetfirst nil (ssget "_P"))
177.       (c:2ndss2spls)
178.       (setq sss (cadr (ssgetfirst)))
179.       (setq e (car (nentselp (trans sp 0 1))))
180.       (command "_.JOIN" e sss "")
181.     )
182.   )
183.   (*error* nil)
184. )
185.  

M.R.

[Stefan]

Stefan,

The code above errors for me at (distance m v) because 'v' returns nil.

Curve fit polylines are nothing more than a bunch of arcs.
It might happen to get an arc of 180deg or it might be replaced by a line, but i guess only after editing or stretching the polyline.
These are the only cases when v is nil and both can be solved.
For the first case you need to divide the arc in 2 segments. You need to do so for arcs larger than 180deg also.
For the second, v=m and w=1.0.

[ribarm]

Curve fit polylines are nothing more than a bunch of arcs.
...

Thanks Stefan for the explanation... I finally ended by exploding curve fit polyline and then convert arcs back to LWPOLYLINE which is also very thankful curve type and maybe even better than spline for my bigger lisp... Unfortunately I can't post that code as it has copyright info, but I am pleased it ended this way, even better than I thought... Now all 2d curve types are included in my lisp and that was my intention in the first place... So thank you for the info, although you see that your version has some lacks, I don't use it anyway...

Very thankful, Marko R.