If you want to create smooth polyline in Autocad you may use command "PEDIT" to create spline or fit curve (quadratic, qubic or Bezier surface).
Fit curve will pass through points that define lwpolyline, but in spline this points will become manipulative vertexes. Since I use rather old version of Autocad I don't know if there are any new options.
I have read somewhare that Catmull Rom spline will be implemented in newer versions (2018 or such).
For those of you that don't have that option here is my script that creates Catmull - Rom spline from a polyline. I wont explain maths behind, you may Google it, or read about Centripetal Catmull–Rom spline on Wikipedia.
If you have closed lwpolyline that consists only of line segments and you convert her to spline or fit curve you will get something like this.
After you start command "CROM" you will get something like this.
You may copy code from here or download it from attachment. In atachment is also a version that use separate .lsp and .dcl files ( and catmull.dcl - no vlisp), and version that autocreates dcl file () .
(setq
interpoints 10
alpha 5
file "c:\\catmull.dcl"
eraser 0
)
(defun keyValue (key el)(cdr (assoc key el)))
(defun equalPoints (pt1 pt2) (apply '= (mapcar '= pt1 pt2)))
(defun lwpolypoints (e / ent elev ptlist closed pt pt1)
(setq
ent (entget e)
elev (keyValue 38 ent)
closed (keyValue 70 ent)
pt1 (keyValue 10 ent)
)
(while (setq ent (member (assoc 10 ent) ent) pt (car ent) ent (cdr ent))
(setq p (list (cadr pt) (caddr pt) elev))
(if (atom ptlist) (setq ptlist (cons p ptlist)))
(if (and (listp ptlist) (not (equalPoints (car ptlist) p))) (setq ptlist (cons p ptlist)))
)
(if (and (eq closed 1) (not (equalPoints (car ptlist) pt1))) (setq ptlist (cons pt1 ptlist)))
(reverse ptlist)
)
(defun point2d (pt)(list (car pt) (cadr pt)))
(defun linsp (start stop n / i ret step ret)(setq step (/ (- stop start) (float (- n 1 ))) i 0)
(repeat n (setq ret (cons (+ start (* i step)) ret) i (+ i 1))) (reverse ret))
(defun tval (tprev pt1 pt2 _alpha / x1 y1 x2 y2 )(+ (expt (expt (+ (expt (- (car pt2) (car pt1)) 2.0)
(expt (- (cadr pt2) (cadr pt1)) 2.0)) 0.5) _alpha) tprev))
(defun catmull_rom_spline (p0 p1 p2 p3 _alpha / t0 t1 t2 t3 tlin k1 k2 k3 m1 m2 m3
a1 a2 a3 r1 r2 s1 s2 b1 b2 g1 g2 c ret)
(setq
t0 0.0
t1 (tval t0 p0 p1 _alpha)
t2 (tval t1 p1 p2 _alpha)
t3 (tval t2 p2 p3 _alpha)
tlin (linsp t1 t2 (+ interpoints 2))
)
(foreach tcur tlin
(setq
k1 (/ (- t1 tcur)(- t1 t0)) m1 (/ (- tcur t0)(- t1 t0))
k2 (/ (- t2 tcur)(- t2 t1)) m2 (/ (- tcur t1)(- t2 t1))
k3 (/ (- t3 tcur)(- t3 t2)) m3 (/ (- tcur t2)(- t3 t2))
a1 (mapcar '+ (mapcar '* (list k1 k1) p0) (mapcar '* (list m1 m1) p1))
a2 (mapcar '+ (mapcar '* (list k2 k2) p1) (mapcar '* (list m2 m2) p2))
a3 (mapcar '+ (mapcar '* (list k3 k3) p2) (mapcar '* (list m3 m3) p3))
r1 (/ (- t2 tcur)(- t2 t0))
s1 (/ (- tcur t0)(- t2 t0))
r2 (/ (- t3 tcur)(- t3 t1))
s2 (/ (- tcur t1)(- t3 t1))
b1 (mapcar '+ (mapcar '* (list r1 r1) a1) (mapcar '* (list s1 s1) a2))
b2 (mapcar '+ (mapcar '* (list r2 r2) a2) (mapcar '* (list s2 s2) a3))
g1 (/ (- t2 tcur)(- t2 t1)) g2 (/ (- tcur t1)(- t2 t1))
c (mapcar '+ (mapcar '* (list g1 g1) b1) (mapcar '* (list g2 g2) b2))
ret (cons c ret)
)
)
(reverse ret)
)
(defun getlwpolypoints (e / ent pts p1 npoints elev m lpt1 lpt2 spt1 spt2 d1 d2 a1 a2 fstart fend );
(setq ent (entget e))
(setq pts (lwpolypoints e) closed (keyValue 70 ent))
(if (eq closed 0)
(progn
(setq
spt1 (car pts)
spt2 (cadr pts)
lpt2 (last pts)
lpt1 (nth (- (length pts) 2) pts)
d1 (distance spt1 spt2)
d2 (distance lpt1 lpt2)
a1 (+ (angle spt2 spt1))
a2 (angle lpt1 lpt2)
fstart (polar spt1 a1 d1)
fend (polar lpt2 a2 d2)
pts (append (list fstart) pts)
pts (append pts (list fend))
)
)
)
(if (eq closed 1)
(progn
(setq
fend (nth 1 pts)
fstart (nth (- (length pts) 2) pts)
pts (append (list fstart) pts)
pts (append pts (list fend))
)
)
)
pts
)
(defun make_catmull_rom_spline (e / npoints i p0 p1 p2 p3 crom)
(setq pts (mapcar 'point2d (getlwpolypoints e))
npoints (length pts)
_alpha (/ alpha 10.0)
i 0)
(while (< i (- npoints 3 ))
(setq
p0 (nth i pts)
p1 (nth (+ i 1) pts)
p2 (nth (+ i 2) pts)
p3 (nth (+ i 3) pts)
crom (append crom (catmull_rom_spline p0 p1 p2 p3 _alpha))
i (+ i 1)
)
)
(entmakex
(apply 'append
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 "0")
(cons 90 (length crom))
'(67 . 0)
'(410 . "Model")
'(62 . 3)
'(70 . 0)
)
(mapcar 'list (mapcar '(lambda (a) (cons 10 a)) crom))
)
)
)
)
(defun C:crom ( / e dcl_id)
(defun point_slider_action (val why)
(if (or (= why 2) (= why 1))
(progn
(set_tile "npoints" val)
(setq interpoints (atoi val))
)
)
)
(defun alpha_slider_action (val why)
(if (or (= why 2) (= why 1))
(progn
(set_tile "alpha" val)
(setq alpha (atoi val))
)
)
)
(defun ebox_action_points (val why)
(if (or (= why 2) (= why 1))
(progn
(set_tile "pointslider" val)
(setq interpoints (atoi val))
)
)
)
(defun ebox_action_alpha (val why)
(if (or (= why 2) (= why 1))
(progn
(set_tile "alphaslider" val)
(setq alpha (atoi val))
)
)
)
(defun toggle_action_eraser (val why)
(if (or (= why 2) (= why 1))
(progn
(set_tile "eraser" val)
(setq eraser (atoi val))
)
)
)
(setq e (car(entsel "\nSelect polyline to smooth >")))
(make_catmull_rom_spline e)
(setq dcl_id (load_dialog file))(if (not (new_dialog "crom" dcl_id)) (exit ))
(set_tile "npoints" (itoa interpoints))
(set_tile "pointslider" (itoa interpoints))
(set_tile "eraser" (itoa eraser))
(action_tile "pointslider" "(point_slider_action $value $reason)")
(action_tile "npoints" "(ebox_action_points $value $reason)")
(set_tile "alpha" (itoa alpha))
(set_tile "alphaslider" (itoa alpha))
(action_tile "alphaslider" "(alpha_slider_action $value $reason)")
(action_tile "alpha" "(ebox_action_alpha $value $reason)")
(action_tile "eraser" "(toggle_action_eraser $value $reason)")
(action_tile "apply" "(entdel(entlast))(make_catmull_rom_spline e)")
(action_tile "accept" "(if (= eraser 1)(entdel e))(done_dialog)");action tile
(action_tile "cancel" "(entdel(entlast))(done_dialog)");action_tile
(start_dialog)
(unload_dialog dcl_id)
(princ)
)
(princ "\nType CROM to create Catmull-Rom spline from lwpolyline (only line segments)")
(princ)After changing number of insertation points and tigthening value (0 0.5 or 1) hit apply button to see how it changes, and exit with OK button. If you apply this function to closed curve you must create it closed, otherwise you will get sharp end.
You may use Catmull Rom splines when spline curve must strictly pass through control points (vertices of the lwpolyline), or just to create more natural looking curve.
Any comment is welcome. Likes are welcome too.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
