Jump to content

(3D)Polyline to Spline?

vanowm

By vanowm
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

vanowm Community Regular

vanowm

Posted
Posted

Hello.

 

Is there a routine to convert a Polyline (3D polyline) to a spline using it's node points as trace points for the spline?

 

P.S.

Can't use fit polylines, due to it's different result than spline and compatibility with other software I use.

 

Thank you.

Link to comment
Share on other sites
GP_ Rising Star

GP_

Posted
Posted

Try this

 

;;;                                   ;;;
;;;         Polyline to Spline        ;;;
;;;            22 dec. 2016           ;;;
;;;        Gian Paolo Cattaneo        ;;;
;;;                                   ;;;

(defun c:pl2spl ( / Lv SPL spl* 3DP Lv n )
   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if (and
           (princ "\nPick POLYLINE to convert it to SPLINE")
           (setq 3DP (ssget ":S:E" '((0 . "*POLYLINE"))))
       )
       (progn
           (setq 3DP (ssname 3DP 0))
           (repeat (setq n (1+ (fix (vlax-curve-getEndParam 3DP))))
               (setq Lv (cons (vlax-curve-getPointAtParam 3DP (setq n (1- n))) Lv))
           )
           (setq SPL (ssadd))            
           (repeat (setq n (1- (length Lv)))
               (setq spl* (ms (car Lv) (cadr Lv)))
               (setq Lv (cdr Lv))
               (setq SPL (ssadd spl* SPL))
           )
           (command "_join" )
           (repeat (setq n (sslength SPL))
               (command (ssname SPL (setq n (1- n))))
           )
           (command "")
           (command "_matchprop" 3DP SPL "")
           (entdel 3DP)
       )
   )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (princ)
)
(defun ms (v1 v2 /)
   (entmakex
       (list
           '(0 . "SPLINE")
           '(100 . "AcDbEntity")
           '(100 . "AcDbSpline")
           '(70 . 40)
           '(71 . 3)
           (cons 74 (length Lv))
           '(44 . 1.0e-005)
           (cons 11 v1)
           (cons 11 v2)
       )
   )
)
(vl-load-com)

Link to comment
Share on other sites
Hippe013 Rising Star

Hippe013

Posted
Posted

Maybe give this a try? This was not tested on AutoCAD 2002 as I am using Civil 3D 2017.

 

(defun c:test ( / ss 3dplobj coords ms splobj)
 (vl-load-com)
 (setq ss (ssget ":s:e" '(( 0 . "POLYLINE"))))
 (if ss
   (progn
     (setq 3dplobj (vlax-ename->vla-object (ssname ss 0)))
     (setq coords (vlax-get-property 3dplobj 'Coordinates))
     (setq ms (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'ModelSpace))
     (setq splobj (vlax-invoke-method ms 'AddSpline coords (vlax-3d-point 0 0 0) (vlax-3d-point 0 0 0)))
     (vlax-invoke-method 3dplobj 'Delete)
     )
   (princ "\nOops. Nothing was selected.")
   )
 (princ)
 )

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted (edited) 


[color=#8b4513]; written by: Grrr[/color]
[color=#8b4513]; Create Spline from 2D/3D Polyline, and match the closed status:[/color]
[b][color=BLACK]([/color][/b]defun C:Pline2Spline [color=#8b4513];| credits to: Lee Mac |; [b][color=FUCHSIA]([/color][/b] / Get3DpolyVertices AddSpline e pLst spl [b][color=FUCHSIA])[/color][/b][/color]
 
 [b][color=FUCHSIA]([/color][/b]defun Get3DpolyVertices [b][color=NAVY]([/color][/b] e / pLst [b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]and [b][color=GREEN]([/color][/b]eq 'ENAME [b][color=BLUE]([/color][/b]type e[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]= [color=#2f4f4f]"POLYLINE"[/color] [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 0 [b][color=PURPLE]([/color][/b]entget e[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]reverse
       [b][color=GREEN]([/color][/b]while [b][color=BLUE]([/color][/b]and [b][color=RED]([/color][/b]setq e [b][color=PURPLE]([/color][/b]entnext e[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 0 [b][color=OLIVE]([/color][/b]entget e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b]setq pLst [b][color=RED]([/color][/b]cons [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 10 [b][color=OLIVE]([/color][/b]entget e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] pLst[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
       [b][color=GREEN])[/color][/b]
     [b][color=MAROON])[/color][/b]
   [b][color=NAVY])[/color][/b]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; defun Get3DpolyVertices[/color]
 
 [b][color=FUCHSIA]([/color][/b]defun AddSpline [b][color=NAVY]([/color][/b] 3DPtLst / Spline [b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]if 
     [b][color=MAROON]([/color][/b]and 
       [b][color=GREEN]([/color][/b]vl-consp 3DPtLst[b][color=GREEN])[/color][/b]
       [b][color=GREEN]([/color][/b]vl-every [b][color=BLUE]([/color][/b]function [b][color=RED]([/color][/b]lambda [b][color=PURPLE]([/color][/b]x[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]and [b][color=TEAL]([/color][/b]vl-consp x[b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]= 3 [b][color=OLIVE]([/color][/b]length x[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]apply 'and [b][color=OLIVE]([/color][/b]mapcar 'numberp x[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] 3DPtLst[b][color=GREEN])[/color][/b]
     [b][color=MAROON])[/color][/b][color=#8b4513]; and[/color]
     [b][color=MAROON]([/color][/b]setq Spline
       [b][color=GREEN]([/color][/b]vla-AddSpline
         [b][color=BLUE]([/color][/b]vlax-get [b][color=RED]([/color][/b]vla-get-ActiveDocument [b][color=PURPLE]([/color][/b]vlax-get-acad-object[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]if [b][color=PURPLE]([/color][/b]equal [b][color=TEAL]([/color][/b]getvar [color=#2f4f4f]"CVPORT"[/color][b][color=TEAL])[/color][/b] 1[b][color=PURPLE])[/color][/b] 'PaperSpace 'ModelSpace[b][color=RED])[/color][/b]   
         [b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b]vlax-safearray-fill 
           [b][color=RED]([/color][/b]vlax-make-safearray vlax-vbDouble [b][color=PURPLE]([/color][/b]cons 0 [b][color=TEAL]([/color][/b]1- [b][color=OLIVE]([/color][/b]length [b][color=GRAY]([/color][/b]apply 'append 3DPtLst[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]apply 'append 3DPtLst[b][color=RED])[/color][/b]
         [b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b]vlax-3d-point '[b][color=RED]([/color][/b]0. 0. 0.[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b]vlax-3d-point '[b][color=RED]([/color][/b]0. 0. 0.[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
       [b][color=GREEN])[/color][/b]
     [b][color=MAROON])[/color][/b][color=#8b4513]; setq Spline[/color]
   [b][color=NAVY])[/color][/b][color=#8b4513]; if [/color]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; defun AddSpline    [/color]
 
 [b][color=FUCHSIA]([/color][/b]setvar 'errno 0[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]/= 52 [b][color=MAROON]([/color][/b]getvar 'errno[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]setq e [b][color=MAROON]([/color][/b]car [b][color=GREEN]([/color][/b]entsel [color=#2f4f4f]"\nPick a pline <exit>: "[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
   [b][color=NAVY]([/color][/b]cond
     [b][color=MAROON]([/color][/b][b][color=GREEN]([/color][/b]= 7 [b][color=BLUE]([/color][/b]getvar 'errno[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]princ [color=#2f4f4f]"\nMissed, try again."[/color][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setvar 'errno 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
     [b][color=MAROON]([/color][/b]e
       [b][color=GREEN]([/color][/b]cond
         [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]wcmatch [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 0 [b][color=OLIVE]([/color][/b]entget e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] [color=#2f4f4f]"~*POLYLINE"[/color][b][color=RED])[/color][/b] [b][color=RED]([/color][/b]princ [color=#2f4f4f]"\nInvalid object."[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]= [color=#2f4f4f]"POLYLINE"[/color] [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 0 [b][color=OLIVE]([/color][/b]entget e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]and
             [b][color=PURPLE]([/color][/b]setq spl [b][color=TEAL]([/color][/b]AddSpline [b][color=OLIVE]([/color][/b]Get3DpolyVertices e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]vla-put-Closed2 spl [b][color=TEAL]([/color][/b]vla-get-Closed [b][color=OLIVE]([/color][/b]vlax-ename->vla-object e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]setvar 'errno 52[b][color=PURPLE])[/color][/b]
           [b][color=RED])[/color][/b][color=#8b4513]; and[/color]
         [b][color=BLUE])[/color][/b]
         [b][color=BLUE]([/color][/b][b][color=RED]([/color][/b]= [color=#2f4f4f]"LWPOLYLINE"[/color] [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 0 [b][color=OLIVE]([/color][/b]entget e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b]and
             [b][color=PURPLE]([/color][/b]setq pLst [b][color=TEAL]([/color][/b]mapcar 'cdr [b][color=OLIVE]([/color][/b]vl-remove-if-not [b][color=GRAY]([/color][/b]function [b][color=AQUA]([/color][/b]lambda [b][color=LIME]([/color][/b]x[b][color=LIME])[/color][/b] [b][color=LIME]([/color][/b]= 10 [b][color=SILVER]([/color][/b]car x[b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] [b][color=GRAY]([/color][/b]entget e[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]if [b][color=TEAL]([/color][/b]= 2 [b][color=OLIVE]([/color][/b]length [b][color=GRAY]([/color][/b]car pLst[b][color=GRAY])[/color][/b][b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [color=#8b4513]; convert to 3D point list[/color]
               [b][color=TEAL]([/color][/b]setq pLst [b][color=OLIVE]([/color][/b]mapcar [b][color=GRAY]([/color][/b]function [b][color=AQUA]([/color][/b]lambda [b][color=LIME]([/color][/b]x[b][color=LIME])[/color][/b] [b][color=LIME]([/color][/b]append x [b][color=SILVER]([/color][/b]list [b][color=YELLOW]([/color][/b]cdr [b][color=WHITE]([/color][/b]assoc 38 [b][color=BLACK]([/color][/b]entget e[b][color=BLACK])[/color][/b][b][color=WHITE])[/color][/b][b][color=YELLOW])[/color][/b][b][color=SILVER])[/color][/b][b][color=LIME])[/color][/b][b][color=AQUA])[/color][/b][b][color=GRAY])[/color][/b] pLst[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [color=#8b4513]; assoc 38, elevation[/color]
               pLst
             [b][color=PURPLE])[/color][/b] 
             [b][color=PURPLE]([/color][/b]setq spl [b][color=TEAL]([/color][/b]AddSpline pLst[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]vla-put-Closed2 spl [b][color=TEAL]([/color][/b]vla-get-Closed [b][color=OLIVE]([/color][/b]vlax-ename->vla-object e[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b]
             [b][color=PURPLE]([/color][/b]setvar 'errno 52[b][color=PURPLE])[/color][/b]
           [b][color=RED])[/color][/b][color=#8b4513]; and[/color]
         [b][color=BLUE])[/color][/b]
       [b][color=GREEN])[/color][/b][color=#8b4513]; cond[/color]
     [b][color=MAROON])[/color][/b][color=#8b4513]; e[/color]
   [b][color=NAVY])[/color][/b][color=#8b4513]; cond[/color]
 [b][color=FUCHSIA])[/color][/b][color=#8b4513]; while[/color]
 
[b][color=BLACK])[/color][/b][color=#8b4513];| defun Spline2Pline |; [b][color=BLACK]([/color][/b]vl-load-com[b][color=BLACK])[/color][/b] [b][color=BLACK]([/color][/b]princ[b][color=BLACK])[/color][/b][/color]

2D:

Spline2Pline.gif

3D:

Spline23DPline.gif

 

I don't know why marko_ribar didn't responded to this thread (usually he's into these stuff - [curves: plines,splines]).

Edited by Grrr
fixed a typo lol
Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

I don't know why marko_ribar didn't responded to this thread (usually he's into these stuff - [curves: plines,splines]).

 

Hi there, I had problems with power supply of Electric Energy for my home... Here are some of my stuff :

 

(defun c:allpls2spls ( / ss i pl )
 (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
 (setq i -1)
 (while (setq pl (ssname ss (setq i (1+ i))))
   (cond
     ( (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
       (sssetfirst nil (ssadd pl))
       (c:lw2spl)
     )
     ( (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< -1 (cdr (assoc 70 (entget pl))) 2))
       (command "_.convertpoly" "l" pl "")
       (sssetfirst nil (ssadd pl))
       (c:lw2spl)
     )
     ( (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 10))
       (sssetfirst nil (ssadd pl))
       (c:3p2spl)
     )
   )
 )
 (princ)
)

 

(defun c:lw2spl ( / *error* arc2spl line2spl loop pl e s ss sss qaf )

 (vl-load-com)

 (defun *error* ( msg )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if qaf (setvar 'qaflags qaf))
   (if msg (prompt msg))
   (princ)
 )

 (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )

          (setq q1 (vlax-curve-GetStartParam e)
                q2 (vlax-curve-GetEndParam e)
                a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle
                pc (mapcar                              ; pc - points on contur
                     (function
                       (lambda (p)
                        (vlax-curve-GetPointAtParam e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                f  (mapcar                               ; f - first deriv on pc
                     (function
                       (lambda (p)
                         (vlax-curve-GetFirstDeriv e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                pe (mapcar                              ; pe - extra control points for spline construction
                     (function
                       (lambda (p1 p2 d1 d2)
                         (inters p1 (mapcar '+ p1 d1)
                                 p2 (mapcar '+ p2 d2)
                                 nil
                                 )
                       )
                     )
                    pc (cdr pc) f (cdr f)
                   )
                ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline
                w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
          )

   (defun make_spline ( pts )
     (entmakex
       (append
          '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
             (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
             (42 . 1.0e-010) (43 . 1.0e-010)
             (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
             (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
          pts
       )
     )
   )

   (defun points ( p w )
     (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
   )

   (entdel e)
   (make_spline (points ps w))

 )

 (defun line2spl ( e / sp ep d )

   (setq sp (cdr (assoc 10 (entget e)))
         ep (cdr (assoc 11 (entget e)))
         d (distance sp ep)
   )

   (entdel e)

   (entmakex
     (list
       '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
       '(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)
     )
   )

 )

 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
 (setq loop T)
 (setq sss (ssget "_I"))
 (if (and sss (eq (cdr (assoc 0 (entget (setq pl (ssname sss 0))))) "LWPOLYLINE")) (setq loop nil))
 (while loop
   (setq pl (car (entsel "\nPick LWPOLYLINE to convert it to SPLINE")))
   (if (and pl (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")) (setq loop nil))
 )
 (setq e (entlast))
 (command "_.EXPLODE" pl)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (setq ss (ssadd))
 (while (setq e (entnext e))
   (if (eq (cdr (assoc 0 (entget e))) "LINE")
     (progn
       (setq s (line2spl e))
       (ssadd s ss)
     )
   )
   (if (eq (cdr (assoc 0 (entget e))) "ARC")
     (progn
       (setq s (arc2spl e))
       (ssadd s ss)
     )
   )
 )
 (setq qaf (getvar 'qaflags))
 (setvar 'qaflags 1)
 (command "_.JOIN" (ssname ss 0) ss)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (*error* nil)
)

 

(defun c:3p2spl ( / *error* line2spl loop pl e s ss sss qaf )

 (vl-load-com)

 (defun *error* ( msg )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if qaf (setvar 'qaflags qaf))
   (if msg (prompt msg))
   (princ)
 )

 (defun line2spl ( e / sp ep d )
   
   (setq sp (cdr (assoc 10 (entget e)))
         ep (cdr (assoc 11 (entget e)))
         d (distance sp ep)
   )
   
   (entdel e)
   
   (entmakex
     (list
       '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
       '(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)
     )
   )
   
 )
 
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
 (setq loop T)
 (setq sss (ssget "_I"))
 (if (and sss (eq (cdr (assoc 0 (entget (setq pl (ssname sss 0))))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 10)) (setq loop nil))
 (while loop
   (setq pl (car (entsel "\nPick 3DPOLYLINE to convert it to SPLINE")))
   (if (and pl (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 10)) (setq loop nil))
 )
 (setq e (entlast))
 (command "_.EXPLODE" pl)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (setq ss (ssadd))
 (while (setq e (entnext e))
   (if (eq (cdr (assoc 0 (entget e))) "LINE")
     (progn
       (setq s (line2spl e))
       (ssadd s ss)
     )
   )
 )
 (setq qaf (getvar 'qaflags))
 (setvar 'qaflags 1)
 (command "_.JOIN" (ssname ss 0) ss)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (*error* nil)
)

 

(defun c:2ndss2spls ( / *error* arc2spl line2spl loop sss i ent ssss )

 (vl-load-com)

 (defun *error* ( msg )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   (if msg (prompt msg))
   (princ)
 )

 (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )

          (setq q1 (vlax-curve-GetStartParam e)
                q2 (vlax-curve-GetEndParam e)
                a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle
                pc (mapcar                              ; pc - points on contur
                     (function
                       (lambda (p)
                        (vlax-curve-GetPointAtParam e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                f  (mapcar                               ; f - first deriv on pc
                     (function
                       (lambda (p)
                         (vlax-curve-GetFirstDeriv e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                pe (mapcar                              ; pe - extra control points for spline construction
                     (function
                       (lambda (p1 p2 d1 d2)
                         (inters p1 (mapcar '+ p1 d1)
                                 p2 (mapcar '+ p2 d2)
                                 nil
                                 )
                       )
                     )
                    pc (cdr pc) f (cdr f)
                   )
                ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe) (cadddr pc)) ; ps - control points for spline
                w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
          )

   (defun make_spline ( pts )
     (entmakex
       (append
          '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
             (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
             (42 . 1.0e-010) (43 . 1.0e-010)
             (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
             (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
          pts
       )
     )
   )
 
   (defun points ( p w )
     (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
   )

   (entdel e)
   (make_spline (points ps w))
   
 )

 (defun line2spl ( e / sp ep d )

   (setq sp (cdr (assoc 10 (entget e)))
         ep (cdr (assoc 11 (entget e)))
         d (distance sp ep)
   )

   (entdel e)

   (entmakex
     (list
       '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
       '(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)
     )
   )
   
 )
 
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
 (setq loop T)
 (setq sss (ssget "_I"))
 (if 
   (and 
     sss 
     (vl-some '(lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "LINE,ARC,*POLYLINE")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex sss))))
   )
   (setq loop nil)
 )
 (while loop
   (setq sss (ssget "_:L" (list '(-4 . "<or") '(0 . "LINE,ARC,LWPOLYLINE") '(-4 . "<and") '(0 . "POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 .  '(70 . 9) '(70 . 128) '(70 . 129) '(-4 . "or>") '(-4 . "and>") '(-4 . "or>"))))
   (if sss (setq loop nil))
 )
 (setq ssss (ssadd))
 (repeat (setq i (sslength sss))
   (setq ent (ssname sss (setq i (1- i))))
   (cond
     ( (eq (cdr (assoc 0 (entget ent))) "LINE")
       (line2spl ent)
       (ssadd (entlast) ssss)
     )
     ( (eq (cdr (assoc 0 (entget ent))) "ARC")
       (arc2spl ent)
       (ssadd (entlast) ssss)
     )
     ( (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       (sssetfirst nil (ssadd ent))
       (c:lw2spl)
       (ssadd (entlast) ssss)
       (sssetfirst nil nil)
     )
     ( (and
         (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
         (or
           (eq (cdr (assoc 70 (entget ent))) 0)
           (eq (cdr (assoc 70 (entget ent))) 1)
           (eq (cdr (assoc 70 (entget ent))) 128)
           (eq (cdr (assoc 70 (entget ent))) 129)
         )
       )
       (command "_.CONVERTPOLY" "_L" ent)
       (while (> (getvar 'cmdactive) 0) (command ""))
       (sssetfirst nil (ssadd ent))
       (c:lw2spl)
       (ssadd (entlast) ssss)
       (sssetfirst nil nil)
     )
     ( (and
         (eq (cdr (assoc 0 (entget ent))) "POLYLINE")
         (or
           (eq (cdr (assoc 70 (entget ent))) 
           (eq (cdr (assoc 70 (entget ent))) 9)
         )
       )
       (sssetfirst nil (ssadd ent))
       (c:3p2spl)
       (ssadd (entlast) ssss)
       (sssetfirst nil nil)
     )
   )
 )
 (sssetfirst nil ssss)
 (*error* nil)
)

 

My versions differs from Grrr's - they create spline(s) that exactly match reference entity(ies)... So it's good to have all those different versions... I almost never need those like Grrr posted - they just touch vertices, but curving are away from original references...

 

Regards, M.R.

Link to comment
Share on other sites
vanowm Community Regular

vanowm

Posted
  • Author
Posted

Thank you all for the codes.

 

@Hippe013:

Your routine works great, but only on 3dpolylines

Attempting add lwpolyline to the selection

    (SETQ ss (SSGET ":s:e" '((-4 . "<or")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "or>"))))

returns error:

error: Automation Error. Too few elements in SafeArray or total number of

elements is not a multiple of three

at 
(SETQ splobj (VLAX-INVOKE-METHOD

line

 

@Grrr:

Getting error

error: no function definition: VLA-PUT-CLOSED2
But after continue it creates 3 out of 4 sides on a closed polyline. Nothing created on non-closed polylines though.

 

@marko_ribar:

Just like GP_'s routine it fails on JOIN command

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

@vanowm:

What version of AutoCAD are you using - 2002? I am using A2014 sp1 with VBA enabler installed, Express Tools, Doslib... I have no problems with JOIN command if I specify inside code (setvar 'qaflags 1) - but be sure to reset it after to 0 - to restore ACAD normal behavior... Also I think that GP's code may work correct, as sometimes it's no matter weather you used QAFLAGS - it's just my preference as my recent testings showed me that routine won't fail that way... When you just use JOIN at command prompt it should be fine no matter what value QAFLAGS is, but I am afraid that your version of ACAD is old for this... I'll upload GIF to let you see what should my codes do... I just demonstrated "2ndss2spls.lsp" in action, but every one of them is good for me... M.R.

 

2hQmioH2hQmioH.gif3dpolys2splines.gif

 

2hQmioHattachment.php?attachmentid=60232&cid=1&stc=1

Edited by marko_ribar
Link to comment
Share on other sites
vanowm Community Regular

vanowm

Posted
  • Author
Posted

Yes, 2002. It doesn't have JOIN command.

 

So with little modification here is Hippe013 routine that works on both 2d and 3d polylines:

(DEFUN c:p2s (/ ss 3dplobj coords ms splobj l n)
   (VL-LOAD-COM)
   (SETQ ss (SSGET ":s:e" '((-4 . "<or") (0 . "POLYLINE") (0 . "LWPOLYLINE") (-4 . "or>"))))
   (IF ss
       (PROGN
           (SETQ 3dplobj (VLAX-ENAME->VLA-OBJECT (SSNAME ss 0)))
           (SETQ coords (VLAX-GET-PROPERTY 3dplobj 'Coordinates))
           (SETQ ms (VLAX-GET-PROPERTY
                        (VLAX-GET-PROPERTY (VLAX-GET-ACAD-OBJECT) 'ActiveDocument)
                        'ModelSpace
                    )
           )
           (IF (= (CDR (ASSOC 0 (ENTGET (SSNAME ss 0)))) "LWPOLYLINE")
               (PROGN
                   (SETQ l      (VLAX-SAFEARRAY->LIST (VARIANT-VALUE coords))
                         n      0
                         coords (LIST)
                   )
                   (REPEAT (/ (LENGTH l) 2)
                       (SETQ coords (APPEND coords (LIST (NTH n l) (NTH (1+ n) l) 0))
                             n      (+ n 2)
                       )
                   )
                   (SETQ coords (VLAX-SAFEARRAY-FILL
                                     (VLAX-MAKE-SAFEARRAY
                                         VLAX-VBDOUBLE
                                         (CONS 0 (1- (LENGTH coords)))
                                     )
                                     coords
                                 )
                                
                   )
               )
           )


           (SETQ splobj (VLAX-INVOKE-METHOD
                            ms
                            'AddSpline
                            coords
                            (VLAX-3D-POINT 0 0 0)
                            (VLAX-3D-POINT 0 0 0)
                        )
           )
;      (vlax-invoke-method 3dplobj 'Delete)
       )
       (PRINC "\nOops. Nothing was selected.")
   )
   (PRINC)
)

Thank you everyone!

 

P.S.There must be a better way convert 2d points coordinates variant list to 3d points.

Link to comment
Share on other sites
Hippe013 Rising Star

Hippe013

Posted
Posted

Another thing you may want to consider is using the elevation property of the LWPolyline and use that for z when building coordinates list. Right now you just have it using a zero elevation.

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted
Another thing you may want to consider is using the elevation property of the LWPolyline and use that for z when building coordinates list. Right now you just have it using a zero elevation.

 

Thats clever, modified my suggestion - whenever OP decides to upgrade his ACAD (IMO thats inevitable) to utilise Marko's codes or mine (to make chips 3D polylines out of it).

No idea where this task is used.

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

@Grrr :

Polylines aren't so good entity types when it comes to work in 3D modelling... I once had to do revsurf from polyline as guide and line as axis of revolution... When exploded surface, 3dfaces were not correctly ordered and also it may produce bad revsurface... With adequate substitute (spline) this isn't the case... Also sweeping or extruding along path with polylines as paths aren't so thankful... I didn't researched, but I may conclude from previous statements that also lofting isn't recommendable... All in all, splines are better when it comes to 3d modelling, but 2d polylines are technical entities and someone stated in the past as I can recall it that splines aren't technical - they are just pretty... I of course disagree with this, but it's far more flexible to dimension or program some code with plines than with splines given the fact that vertices are easier to obtain either through Vanilla or Visual Lisp and with splines this is somewhat heavier and rigid - not so exact - both DXF10 and DXF11 codes are connected with spline vertices calculations...

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted (edited)

Thanks for shedding light about this, Marko.

So obviously splines provide smooth geometry for "curved" 3D objects.

And IMO kinda complex when it comes to lisp, after seeing these properties:

;   ControlPoints = (-96.6695 52.3015 0.0 -30.6433 148.557 0.0 ... )
;   FitPoints = (-96.6695 52.3015 0.0 128.612 251.271 0.0 ... )
;   Knots = (0.0 0.0 0.0 0.0 300.567 646.999 ... )

 

 

============================

Anyway I wrote something related:

 

; Test function for (LWPolyline->Spline)
(defun C:test ( / SS i )
 (if (setq SS (ssget "_:L" (list (cons 0 "LWPOLYLINE"))))
   (repeat (setq i (sslength SS))
     (LWPolyline->Spline (ssname SS (setq i (1- i))))
   )
 )
 (princ)
); defun C:test for (LWPolyline->Spline)

(defun LWPolyline->Spline ( e / crds VLApointsLst cnt Spline )
 (if 
   (and
     (eq 'ENAME (type e))
     (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
     (setq crds (vla-get-Coordinates (vlax-ename->vla-object e))) ; obtain the coordinates
     (setq VLApointsLst ; convert from 2D to 3D coordinates
       (apply 'append
         (mapcar 
           (function 
             (lambda (x) 
               (and (not cnt) (setq cnt 0)) 
               (if (< cnt 2) (setq cnt (1+ cnt)) (setq cnt 1))
               (if (= 2 cnt)
                 (list x (cdr (assoc 38 (entget e)))) ; obtain the elevation, old was: (list x 0.)
                 (list x)
               )
             ); lambda
           )
           (vlax-safearray->list (vlax-variant-value crds))
         ); mapcar
       ); apply 'append
     ); setq VLApointsLst
   ); and
   (vla-put-Closed2
     (setq Spline
       (vla-AddSpline
         (vlax-get (vla-get-ActiveDocument (vlax-get-acad-object))
           (if (equal (getvar "CVPORT") 1) 'PaperSpace 'ModelSpace)   
         )
         (vlax-safearray-fill 
           (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length VLApointsLst))))
           VLApointsLst
         )
         (vlax-3d-point '(0. 0. 0.))
         (vlax-3d-point '(0. 0. 0.))
       ); vla-AddSpline
     ); setq Spline
     (vla-get-Closed (vlax-ename->vla-object e))
   ); vla-put-Closed2
 ); if
 Spline
); defun LWPolyline->Spline

Although It works only with LWplines, and I don't think it will work for ACAD 2002. (Just wanted to leave this here)

Edited by Grrr
Link to comment
Share on other sites
Hippe013 Rising Star

Hippe013

Posted
Posted

@grr

(to make chips 3D polylines out of it).
I am not quite sure what you mean by this. I haven't tested your guy's code but is the end result the same for all of our code?

 

I have modified my code to accept lwpolyline and 3dpolyline as well as accounting for whether the original object was closed or not.

 

(defun c:test ( / ss 3dplobj coords ms splobj objn n li)
 (vl-load-com)
 (setq ss (ssget ":s:e" '(( 0 . "POLYLINE,LWPOLYLINE"))))
 (if ss
   (progn
     (setq 3dplobj (vlax-ename->vla-object (ssname ss 0)))
     (setq objn (vlax-get-property 3dplobj 'ObjectName))
     (setq coords (vlax-get-property 3dplobj 'Coordinates))
     (if (= "AcDbPolyline" objn)
(progn
  (setq coords (vlax-safearray->list (vlax-variant-value coords)))
  (setq elev (vlax-get-property 3dplobj 'Elevation))
  (setq n 0)
  (repeat (/ (length coords) 2)
    (setq li (append li (list (nth n coords)(nth (+ n 1) coords) elev)))
    (setq n (+ n 2))
    )
  (setq coords (pl->var li))
  )
)
     (setq ms (vlax-get-property (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'ModelSpace))
     (setq splobj (vlax-invoke-method ms 'AddSpline coords (vlax-3d-point 0 0 0) (vlax-3d-point 0 0 0)))
     (if (= :vlax-true (vlax-get-property 3dplobj 'Closed))
(vlax-put-property splobj 'Closed2 :vlax-true))
     (vlax-invoke-method 3dplobj 'Delete)
     )
   (princ "\nOops. Nothing was selected.")
   )
 (princ)
 )


;Given Pointlist returns pointlist in variant form
(defun pl->var ( pl / pl ub sa var)
 (setq ub (- (length pl) 1))
 (setq sa (vlax-make-safearray vlax-vbdouble (cons 0 ub)))
 (setq var (vlax-make-variant (setq sa (vlax-safearray-fill sa pl))))
 )

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
Posted
@grr I am not quite sure what you mean by this.

That was a joke (the closed 3Dpolyline gets a shape like a chips).

 

I haven't tested your guy's code but is the end result the same for all of our code?

Well your and mine suggestion will have the same result, but not Marko's.

The first code you posted didn't work on LWPOLYLINEs, so I decided to write a version for myself (+ I could easier understand whats happening in my code).

EDIT: and I didn't mentioned you, because OP comfirmed that your code works on ACAD 2002 - I ment for the above versions.

Link to comment
Share on other sites
  • 7 years later...
Vittorio Apprentice

Vittorio

Posted
Posted

Sorry for reviving this old thread, but it seems to be exactly what I've been looking for.

 

I have a Civil 3D drawing with a RCP Point Cloud and an Orthofoto and 3D Polylines (exported from Leica Cyclone 3DR).

The problem is that those Polylines don't match with the reality, only its vertices.

What I need to do is drawing Splines and 3D-Polylines on top of the existing (from 3DR) 3D-Polyline Vertices, depending if the segment is curved (> Spline) or linear (> 3DP) to match the real world edges.

Since the Polylines have a large number of vertices this procedure is time-consuming.

 

Now I've found this interesting and promising thread and I wonder if any of those LISP routines posted here will get this task done.

 

The above is just for explanation. Actually what i need to do is drawing a Spline by connecting all Vertices of a selected 3D-Polyline.

 

Here are two screenshots showing the scenario:

Image1.thumb.jpg.41b9312ea08e1293fdc6f0d8e678d4f6.jpg

 

 

 

Image2.thumb.jpg.a8f6413edb7783330c3ede485186e1a9.jpg

 

Could someone please tell me if one of the posted LISP functions will work for me?

 

Many thanks in advance.

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted
1 hour ago, Vittorio said:

Sorry for reviving this old thread, but it seems to be exactly what I've been looking for.

 

I have a Civil 3D drawing with a RCP Point Cloud and an Orthofoto and 3D Polylines (exported from Leica Cyclone 3DR).

The problem is that those Polylines don't match with the reality, only its vertices.

What I need to do is drawing Splines and 3D-Polylines on top of the existing (from 3DR) 3D-Polyline Vertices, depending if the segment is curved (> Spline) or linear (> 3DP) to match the real world edges.

Since the Polylines have a large number of vertices this procedure is time-consuming.

 

Now I've found this interesting and promising thread and I wonder if any of those LISP routines posted here will get this task done.

 

The above is just for explanation. Actually what i need to do is drawing a Spline by connecting all Vertices of a selected 3D-Polyline.

 

Here are two screenshots showing the scenario:

Image1.thumb.jpg.41b9312ea08e1293fdc6f0d8e678d4f6.jpg

 

 

 

Image2.thumb.jpg.a8f6413edb7783330c3ede485186e1a9.jpg

 

Could someone please tell me if one of the posted LISP functions will work for me?

 

Many thanks in advance.

 

Here, you meight find these 2 routines useful...

Here is the link : https://www.theswamp.org/index.php?topic=59534.msg620732#msg620732

 

Regards, M.R.

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Just a personal comment.

 

Having worked on road designs for to many years I am not sure you will get a correct answer that you may be looking for.  In the image it looks like a kerb edge so using cloud data is based on a grid pattern, so you can have a interpreted point that is a top of kerb and next point is lower at lip of kerb. The big issue with using clouds is they suffer when it comes to vertical edges. If a drone is used its scanning vertically on a grid basis, if a 3d scanner is used you may get a more realistic model as it can detect the change in edge levels. Think Gb clouds. Think of the Google car views as you walk down the road. 

 

Marko has given you an answer to the CAD question but for me as a designer I would have that portion field surveyed if your gong to use it for design purposes, a man with a stick. We surveyed one point on kerb and back in office added 2 more with offset and Z change. Our confidence on z level was like less than 10mm. 

 

Lastly we did compare a instrument survey with a drone cloud and found a +- 20mm max difference of points on a flattish length of road. Showing that under certain design criteria clouds were very useful.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...