vanowm Posted December 22, 2016 Share Posted December 22, 2016 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. Quote Link to comment Share on other sites More sharing options...
GP_ Posted December 22, 2016 Share Posted December 22, 2016 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) Quote Link to comment Share on other sites More sharing options...
vanowm Posted December 22, 2016 Author Share Posted December 22, 2016 Thank you. Unfortunately it fails on join command (Autocad 2002 doesn't have it?) Quote Link to comment Share on other sites More sharing options...
Hippe013 Posted December 22, 2016 Share Posted December 22, 2016 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) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 23, 2016 Share Posted December 23, 2016 (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: 3D: I don't know why marko_ribar didn't responded to this thread (usually he's into these stuff - [curves: plines,splines]). Edited December 23, 2016 by Grrr fixed a typo lol Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted December 23, 2016 Share Posted December 23, 2016 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. Quote Link to comment Share on other sites More sharing options...
vanowm Posted December 23, 2016 Author Share Posted December 23, 2016 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-CLOSED2But 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 Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted December 23, 2016 Share Posted December 23, 2016 (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. Edited December 23, 2016 by marko_ribar Quote Link to comment Share on other sites More sharing options...
vanowm Posted December 23, 2016 Author Share Posted December 23, 2016 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. Quote Link to comment Share on other sites More sharing options...
Hippe013 Posted December 23, 2016 Share Posted December 23, 2016 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. Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 23, 2016 Share Posted December 23, 2016 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. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted December 23, 2016 Share Posted December 23, 2016 @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... Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 23, 2016 Share Posted December 23, 2016 (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 December 23, 2016 by Grrr Quote Link to comment Share on other sites More sharing options...
Hippe013 Posted December 23, 2016 Share Posted December 23, 2016 @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)))) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted December 23, 2016 Share Posted December 23, 2016 @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. Quote Link to comment Share on other sites More sharing options...
vanowm Posted December 24, 2016 Author Share Posted December 24, 2016 @Grrr, no doesn't work in 2002 @Hippie013, your last code works wonderful Thank you! Quote Link to comment Share on other sites More sharing options...
Vittorio Posted June 12 Share Posted June 12 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: Could someone please tell me if one of the posted LISP functions will work for me? Many thanks in advance. Quote Link to comment Share on other sites More sharing options...
marko_ribar Posted June 12 Share Posted June 12 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: 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 12 Share Posted June 12 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. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.