（3D）多段线到样条曲线？
你好是否有将多段线（三维多段线）的节点点用作样条曲线的跟踪点的例程来将其转换为样条曲线？
附笔。
无法使用拟合多段线，因为它的结果与样条线不同，并且与我使用的其他软件兼容。
非常感谢。 试试这个
;;; ;;;
;;; 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) 非常感谢。
不幸的是，它在join命令上失败（Autocad 2002没有它？） 也许可以试试？这没有在AutoCAD 2002上测试，因为我使用的是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)
)
; written by: Grrr
; Create Spline from 2D/3D Polyline, and match the closed status:
(defun C:Pline2Spline ;| credits to: Lee Mac |; ( / Get3DpolyVertices AddSpline e pLst spl )
(defun Get3DpolyVertices ( e / pLst )
(if (and (eq 'ENAME (type e)) (= "POLYLINE" (cdr (assoc 0 (entget e)))))
(reverse
(while (and (setq e (entnext e)) (/= "SEQEND" (cdr (assoc 0 (entget e)))))
(setq pLst (cons (cdr (assoc 10 (entget e))) pLst))
)
)
)
); defun Get3DpolyVertices
(defun AddSpline ( 3DPtLst / Spline )
(if
(and
(vl-consp 3DPtLst)
(vl-every (function (lambda (x) (and (vl-consp x) (= 3 (length x)) (apply 'and (mapcar 'numberp x))))) 3DPtLst)
); and
(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 (apply 'append 3DPtLst)))))
(apply 'append 3DPtLst)
)
(vlax-3d-point '(0. 0. 0.))
(vlax-3d-point '(0. 0. 0.))
)
); setq Spline
); if
); defun AddSpline
(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
(setq e (car (entsel "\nPick a pline <exit>: ")))
(cond
((= 7 (getvar 'errno)) (princ "\nMissed, try again.") (setvar 'errno 0))
(e
(cond
((wcmatch (cdr (assoc 0 (entget e))) "~*POLYLINE") (princ "\nInvalid object."))
((= "POLYLINE" (cdr (assoc 0 (entget e))))
(and
(setq spl (AddSpline (Get3DpolyVertices e)))
(vla-put-Closed2 spl (vla-get-Closed (vlax-ename->vla-object e)))
(setvar 'errno 52)
); and
)
((= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
(and
(setq pLst (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) (entget e))))
(if (= 2 (length (car pLst))) ; convert to 3D point list
(setq pLst (mapcar (function (lambda (x) (append x (list (cdr (assoc 38 (entget e))))))) pLst)) ; assoc 38, elevation
pLst
)
(setq spl (AddSpline pLst))
(vla-put-Closed2 spl (vla-get-Closed (vlax-ename->vla-object e)))
(setvar 'errno 52)
); and
)
); cond
); e
); cond
); while
);| defun Spline2Pline |; (vl-load-com) (princ)
2D：
3D：
我不知道为什么marko_ribar没有回应这个帖子（通常他喜欢这些东西-[曲线：普林斯，样条]）。
您好，我有问题的电力供应，为我的家。。。以下是我的一些资料：
(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)
)
我的版本与Grrr不同-它们创建的样条线与参考实体完全匹配。。。所以很高兴有这么多不同的版本。。。我几乎从不需要那些像Grrr张贴-他们只是触摸顶点，但弯曲远离原始参考。。。
您好，M.R。 谢谢大家的代码。
@Hippe013：
您的例程效果很好，但仅适用于三维多段线
正在尝试将LWDOLYLINE添加到选择中
(SETQ ss (SSGET ":s:e" '((-4 . "<or")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "or>"))))返回错误：
在(SETQ splobj (VLAX-INVOKE-METHOD线上
@Grrr：
获取错误
但在继续后，它会在闭合多段线上创建4条边中的3条。但在非闭合多段线上没有创建任何内容。
@marko_ribar：
就像GP_的例程一样，它在JOIN命令时失败 @瓦诺姆：
您使用的是什么版本的AutoCAD-2002？我正在使用安装了VBA enabler的A2014 sp1、Express Tools、Doslib。。。如果我指定了内部代码（setvar'qaflags 1），我对JOIN命令没有问题，但请确保在将其重置为0后，恢复ACAD的正常行为。。。此外，我认为GP的代码可能工作正常，因为有时无论您是否使用QAFLAGS，这只是我的偏好，因为我最近的测试表明，例程不会以这种方式失败。。。当您仅在命令提示符下使用JOIN时，无论QAFLAGS的值是多少，都应该没有问题，但我担心您的ACAD版本在此方面已经过时了。。。我会上传GIF让你看看我的代码应该做什么。。。我刚刚在实践中演示了“2ndss2spls.lsp”，但它们中的每一个都对我有好处。。。M、 R。
http://gph.is/2hQmioH
http://gph.is/2hQmioHhttps://www.cadtutor.net/forum/attachment.php?attachmentid=60232&cid=1&stc=1 是的，2002年。它没有JOIN命令。
因此，只需稍加修改，即可在二维和三维多段线上运行Hippe013例程：
(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)
)
谢谢大家！
P、 必须有更好的方法将2d点坐标变量列表转换为3d点。 您可能需要考虑的另一件事是使用LWPolyline的高程特性，并在构建坐标列表时将其用于z。现在你只需要使用零海拔。
页:
[1]
2