Centerline between two polylines

[SLW210]

Downloads fine here. Perhaps being blocked on your end.

 

What have you tried and what exactly is the problem you are having?

[JerryFiedler]

You must be logged onto the forum before a download is "available".  Prior to signing in the downloads are flagged with "Unavailable".  After signing in the flag change to the file size and a click on the file name executes the download.  I just downloaded the file a few minutes ago.

[Tomislav]

thanx

[jose rmz]

On 21/12/2013 at 13:06, GP_ said:

Un enfoque gráfico para aproximar una línea central entre dos polilíneas.

 

Jugar

 

 

 

 

ps No exagere con curvas cerradas.

pps Para AutoCAD 2011 o superior

centerPline.LSPIndisponible

cual es el comando par ausar??

 

[Dadgad]

Bien venidos jose rmz.   

The shortcall for the lisp is    CPL   like in the screenshot

 

 

[dsurveng]

On 12/21/2013 at 8:06 PM, GP_ said:

A graphical approach to approximate a centerline between two polylines.

 

To play

 

 

 

 

p.s. Do not exaggerate with sharp curves.

p.p.s. For AutoCAD 2011 or higher

centerPline.LSP 10 kB · 753 downloads

Thank you!! Awesome!

[sid1627]

On 11/8/2014 at 11:54 AM, GreenDD said:

Thanks for your anwser M.R.!

 

But it should work more in the way that it create the centerline of one polygon and not with another.

So that i get the green centerline out of the with closed polygon in the picture.

 

 

This works perfect!! but I was wondering was there a solution found to the question above where it can be found within a closed Polygon

[raymarcher]

I do not get further than the LISP creating nurbs.

Though from there on I can extract the line with intersect.

Anyone else having this problem?

[enthralled]

The following Lisp worked well in Autocad 2024. But in AUtocad 2025 it's telling me "Express Tools are not installed. If there are curves the centerline is drawn with a spline." I think it is checking for the "flatten" command in the express tools, although I do have that command along with the express tools. Can anyone please tell me how to fix:
 

;;;************************ centerPline.LSP ***********************;;;
;;;                                                                ;;;
;;;                Centerline between two polyline                 ;;;
;;;                                                                ;;;
;;;                  author: Gian Paolo Cattaneo                   ;;;
;;;                                                                ;;;
;;;                  version: 1.0  -  21.12.2013                   ;;;
;;;                                                                ;;;
;;;****************************************************************;;;


(defun c:CPL ( / *error* Loft_n Loft_p Loft_u Loft_v :e1 :e2
                 e1 e2 p1 p2 D_off EL e1o e2o L1 L2 EL1 E_new
                 *pl* E_join pa pb e_del results rip)

    (defun *error* ( msg )
        (command "_.undo" "_end")
        (if Loft_n (setvar 'loftnormals Loft_n))
        (if Loft_p (setvar 'loftparam Loft_p))
        (if Loft_u (setvar 'surfu Loft_u))
        (if Loft_v (setvar 'surfv Loft_v))
        (if pl_type (setvar 'plinetype pl_type))
        (setvar 'cmdecho cmd)

        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (command "_.undo" "_begin")    

    (if (null ETmsg) (check_ET))
    (check_ucs)
    (check_view)
    (check_ver)

    (setq Loft_n (getvar 'loftnormals))
    (setq Loft_p (getvar 'loftparam))
    (setq Loft_u (getvar 'surfu))
    (setq Loft_v (getvar 'surfv))
    (setq pl_type (getvar 'plinetype))

    (setvar 'loftnormals 0)
    (setvar 'loftparam 7)
    (setvar 'surfu 0)
    (setvar 'surfv 0)
    (if (= 0 (getvar 'plinetype)) (setvar 'plinetype 1))

    (if (and
            (setq :e1 (<sel> "\nSelect First Polyline"))
	    (setq p1 (cadr :e1))
	    (setq :e1 (car :e1))
            (not (redraw :e1 3))
            (setq :e2 (<sel> "\nSelect Second Polyline"))
	    (setq p2 (cadr :e2))
	    (setq :e2 (car :e2))	    
        )
        (progn
            (redraw :e1 4)
            (check_elev)
            (check_normal)
            (setq e1 (entmakex (cdr (entget :e1))))
            (setq e2 (entmakex (cdr (entget :e2))))
            (setq D_off (* (Max (MaxDist e1 e2) (MaxDist e2 e1)) 0.53))
	    
            (setq EL (entlast))
            (command "_offset" D_off e1 "_non" p2 "")
            (setq e1o (entlast))	    
            (check_offset)

            (setq EL (entlast))
            (command "_offset" D_off e2 "_non" p1 "")
            (setq e2o (entlast))
            (check_offset)   

            (command "_move" e1o e2o "" "_non" "0,0,0" "_non" (list 0.0 0.0 (* D_off 0.5)))

            (command "_loft" e1 e1o "" "")
            (setq L1 (entlast))
            (command "_loft" e2 e2o "" "")
            (setq L2 (entlast))

            (setq EL (entlast) EL1 EL)

            (command "_intersect" L1 L2 "")

            (mapcar
               '(lambda (x)
                    (if (not (vlax-erased-p x)) (entdel x))
                )
                (list e1o e2o e1 e2 L1 L2)
            )       

            (if (> (sslength (setq E_new (e_next EL "SS"))) 0)
                (progn
                    (if :ET:     
                        (acet-flatn E_new nil)
                        (progn
                            (command "_move" E_new "" "_non" "0,0,0" "_non" "0,0,1e99")
                            (command "_move" E_new "" "_non" "0,0,0" "_non" "0,0,-1e99")
                        )
                    )
                    (setq E_join (e_next EL1 "LS"))

                    (if (= "LINE" (cdr (assoc 0 (entget (car E_join)))))
                        (progn
                            (setq pa (trans (cdr (assoc 10 (entget (car E_join)))) 0 1))
                            (setq pb (trans (cdr (assoc 11 (entget (car E_join)))) 0 1))
                            (command "_pline" "_non" pa "_non" pb "")
                            (setq E_join (subst (entlast) (setq e_del (car E_join)) E_join))
                            (entdel e_del)
                        )
                    )
                    (command "_.join")
                    (apply 'command E_join)
                    (command "")
                    (setq results t)
                )
            )
        )
    )
    (setvar 'loftnormals Loft_n)
    (setvar 'loftparam Loft_p)
    (setvar 'surfu Loft_u)
    (setvar 'surfv Loft_v)
    (setvar 'plinetype pl_type)
    (command "_.undo" "_end")
    (setvar 'cmdecho cmd)
    (prompt "\n ") (prompt "\n ")(prompt "\n ")
    (if results (prompt (strcat "\nCenterline created " (if :ET: "(Polyline)." "(Spline)."))))
    (princ)
)

;****************************************************************************

(defun check_ET ()
    (if (member "acetutil.arx" (arx))
        (progn
            (or acet-flatn (load "FLATTENSUP.LSP"))
            (setq :ET: t)
        )
        (progn
            (setq :ET: nil)
            (alert
                (strcat
                    "Express Tools are not installed."
                    "\nIf there are curves the centerline is drawn with a spline."
                )
            )
	    (setq ETmsg t) 
        )
    )
)

;****************************************************************************

(defun check_ucs ()
    (or
        (and
            (zerop (caddr (getvar 'ucsxdir)))
            (zerop (caddr (getvar 'ucsydir)))
        )
        (progn
            (alert "UCS not normal to the WCS")
            (exit)
        )
    )
)
                           
;****************************************************************************

(defun check_view ()
    (or
        (and
            (zerop (car (getvar 'viewdir)))
            (zerop (cadr (getvar 'viewdir)))
            (> (caddr (getvar 'viewdir)) 0)
        )
        (progn
            (alert "View needs to be in plan (0 0 1)")
            (exit)
        )
    )
)

;****************************************************************************

(defun check_ver ()
    (if (< (atoi (substr (ver) 13)) 2011)
        (progn
            (alert "This routine require AutoCAD 2011 or higher.")
            (exit)
        )
    )
)

;****************************************************************************

(defun <sel> (<msg> / *poly* *esel* *p*)
    (while (not *poly*)
        (setvar "errno" 0)
        (setq *esel* (entsel <msg>))
        (setq *poly* (car *esel*))
        (setq *p* (cadr *esel*))
        (if (= 7 (getvar 'errno))
            (alert "No objects selected")
        )
        (if (= 'ename (type *poly*))
            (cond
                ( (null (wcmatch (cdr (assoc 0 (entget *poly*))) "LWPOLYLINE"))
                  (alert "Invalid selection, the object is not a LWPOLYLINE.")
                  (setq *poly* nil)
                )
                ( (= 1 (logand 1 (cdr (assoc 70 (entget *poly*)))))
                  (alert "Invalid selection, the polyline is not open.")
                  (setq *poly* nil)
                )
            )
        )
    )
    (list *poly* *p*)
)

;****************************************************************************

(defun check_elev ()
    (if
        (not
            (equal
                (cdr (assoc 38 (entget :e1)))
                (cdr (assoc 38 (entget :e2)))
                1e-6
            )
        )
        (progn
            (alert "Polylines have different elevation.")
            (exit)
        )
    )
)

;****************************************************************************

(defun check_normal ()
    (if
        (or
            (not (equal (cdr (assoc 210 (entget :e1))) '(0.0 0.0 1.0) ))
            (not (equal (cdr (assoc 210 (entget :e2))) '(0.0 0.0 1.0) ))
        )
        (progn
            (alert "Polyline is not normal to the WCS.")
            (exit)
        )
    )
)

;****************************************************************************

(defun e_next (entL mode / next)
    (if (= mode "SS") (setq next (ssadd)))
    (if (/= entL (entlast))
        (while (setq entL (entnext entL))
       	    (if (entget entL)
                (cond
                    ( (= mode "LS") (setq next (cons entL next)) )
                    ( (= mode "SS") (setq next (ssadd entL next)) )
                )
            )
        )
    )
    next
)

;****************************************************************************

(defun check_offset ( / o_del)
    (if rip (setq rip (1+ rip)) (setq rip 1))
    (if (> (length (setq o_del (e_next EL "LS"))) 1)
        (progn
            (entdel e1)
            (entdel e2)
            (if (= rip 2) (entdel e1o))
            (mapcar
               '(lambda (x)
                    (if (not (vlax-erased-p x)) (entdel x))
                )
                o_del
            )
            (alert
                (strcat
                    "Modeling failed."
                    "\nTry to split the polylines into more portions."
                )
            )
            (exit)
        )
    )
)

;****************************************************************************

(defun MaxDist (ent1 ent2 / :step De1 :div p_step :D Dmax)
    (setq :step (/ (setq De1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500))
    (setq :div :step)
    (setq Dmax 0.00)
    (while (< :div De1)
        (setq p_step (vlax-curve-getPointAtDist ent1 :div))
        (setq :D (distance p_step (vlax-curve-getClosestPointTo ent2 p_step)))
        (if (> :D Dmax) (setq Dmax :D))
        (setq :div (+ :div :step))
    )
    Dmax
)

;****************************************************************************

(vl-load-com)

(prompt "\n ") (prompt "\n ")
(princ "\nCenterline between two polyline - by Gian Paolo Cattaneo")
(princ "\ncenterPline.LSP loaded ............... Type \"CPL\" to run ")
(princ)

 

[GP_]

1 hour ago, enthralled said:

...although I do have that command along with the express tools.

 

Try to exclude check here (add a semicolon):

;(if (null ETmsg) (check_ET))

 

add:

(setq :ET: T)

 

Edited September 10 by GP_

[enthralled]

29 minutes ago, GP_ said:

 

Try to exclude check here (add a semicolon):

;(if (null ETmsg) (check_ET))

 

add:

(setq :ET: T)

 

Now I am not getting the error popup, but the result is separate lines and splines (not joined) and still not getting arcs.

Previously I was getting a single joined Spline, and when i manually run flatten on that object it is converted to a polyline (which is a workaround).

Below is the modified one as you suggested:

;;;************************ centerPline.LSP ***********************;;;
;;;                                                                ;;;
;;;                Centerline between two polyline                 ;;;
;;;                                                                ;;;
;;;                  author: Gian Paolo Cattaneo                   ;;;
;;;                                                                ;;;
;;;                  version: 1.0  -  21.12.2013                   ;;;
;;;                                                                ;;;
;;;****************************************************************;;;


(defun c:CPL ( / *error* Loft_n Loft_p Loft_u Loft_v :e1 :e2
                 e1 e2 p1 p2 D_off EL e1o e2o L1 L2 EL1 E_new
                 *pl* E_join pa pb e_del results rip)

    (defun *error* ( msg )
        (command "_.undo" "_end")
        (if Loft_n (setvar 'loftnormals Loft_n))
        (if Loft_p (setvar 'loftparam Loft_p))
        (if Loft_u (setvar 'surfu Loft_u))
        (if Loft_v (setvar 'surfv Loft_v))
        (if pl_type (setvar 'plinetype pl_type))
        (setvar 'cmdecho cmd)

        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (setq cmd (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (command "_.undo" "_begin")    

 ;   (if (null ETmsg) (check_ET))

    (check_ucs)
    (check_view)
    (check_ver)

    (setq Loft_n (getvar 'loftnormals))
    (setq Loft_p (getvar 'loftparam))
    (setq Loft_u (getvar 'surfu))
    (setq Loft_v (getvar 'surfv))
    (setq pl_type (getvar 'plinetype))
    
(setq :ET: T)

    (setvar 'loftnormals 0)
    (setvar 'loftparam 7)
    (setvar 'surfu 0)
    (setvar 'surfv 0)
    (if (= 0 (getvar 'plinetype)) (setvar 'plinetype 1))

    (if (and
            (setq :e1 (<sel> "\nSelect First Polyline"))
	    (setq p1 (cadr :e1))
	    (setq :e1 (car :e1))
            (not (redraw :e1 3))
            (setq :e2 (<sel> "\nSelect Second Polyline"))
	    (setq p2 (cadr :e2))
	    (setq :e2 (car :e2))	    
        )
        (progn
            (redraw :e1 4)
            (check_elev)
            (check_normal)
            (setq e1 (entmakex (cdr (entget :e1))))
            (setq e2 (entmakex (cdr (entget :e2))))
            (setq D_off (* (Max (MaxDist e1 e2) (MaxDist e2 e1)) 0.53))
	    
            (setq EL (entlast))
            (command "_offset" D_off e1 "_non" p2 "")
            (setq e1o (entlast))	    
            (check_offset)

            (setq EL (entlast))
            (command "_offset" D_off e2 "_non" p1 "")
            (setq e2o (entlast))
            (check_offset)   

            (command "_move" e1o e2o "" "_non" "0,0,0" "_non" (list 0.0 0.0 (* D_off 0.5)))

            (command "_loft" e1 e1o "" "")
            (setq L1 (entlast))
            (command "_loft" e2 e2o "" "")
            (setq L2 (entlast))

            (setq EL (entlast) EL1 EL)

            (command "_intersect" L1 L2 "")

            (mapcar
               '(lambda (x)
                    (if (not (vlax-erased-p x)) (entdel x))
                )
                (list e1o e2o e1 e2 L1 L2)
            )       

            (if (> (sslength (setq E_new (e_next EL "SS"))) 0)
                (progn
                    (if :ET:     
                        (acet-flatn E_new nil)
                        (progn
                            (command "_move" E_new "" "_non" "0,0,0" "_non" "0,0,1e99")
                            (command "_move" E_new "" "_non" "0,0,0" "_non" "0,0,-1e99")
                        )
                    )
                    (setq E_join (e_next EL1 "LS"))

                    (if (= "LINE" (cdr (assoc 0 (entget (car E_join)))))
                        (progn
                            (setq pa (trans (cdr (assoc 10 (entget (car E_join)))) 0 1))
                            (setq pb (trans (cdr (assoc 11 (entget (car E_join)))) 0 1))
                            (command "_pline" "_non" pa "_non" pb "")
                            (setq E_join (subst (entlast) (setq e_del (car E_join)) E_join))
                            (entdel e_del)
                        )
                    )
                    (command "_.join")
                    (apply 'command E_join)
                    (command "")
                    (setq results t)
                )
            )
        )
    )
    (setvar 'loftnormals Loft_n)
    (setvar 'loftparam Loft_p)
    (setvar 'surfu Loft_u)
    (setvar 'surfv Loft_v)
    (setvar 'plinetype pl_type)
    (command "_.undo" "_end")
    (setvar 'cmdecho cmd)
    (prompt "\n ") (prompt "\n ")(prompt "\n ")
    (if results (prompt (strcat "\nCenterline created " (if :ET: "(Polyline)." "(Spline)."))))
    (princ)
)

;****************************************************************************

(defun check_ET ()
    (if (member "acetutil.arx" (arx))
        (progn
            (or acet-flatn (load "FLATTENSUP.LSP"))
            (setq :ET: t)
        )
        (progn
            (setq :ET: nil)
            (alert
                (strcat
                    "Express Tools are not installed."
                    "\nIf there are curves the centerline is drawn with a spline."
                )
            )
	    (setq ETmsg t) 
        )
    )
)

;****************************************************************************

(defun check_ucs ()
    (or
        (and
            (zerop (caddr (getvar 'ucsxdir)))
            (zerop (caddr (getvar 'ucsydir)))
        )
        (progn
            (alert "UCS not normal to the WCS")
            (exit)
        )
    )
)
                           
;****************************************************************************

(defun check_view ()
    (or
        (and
            (zerop (car (getvar 'viewdir)))
            (zerop (cadr (getvar 'viewdir)))
            (> (caddr (getvar 'viewdir)) 0)
        )
        (progn
            (alert "View needs to be in plan (0 0 1)")
            (exit)
        )
    )
)

;****************************************************************************

(defun check_ver ()
    (if (< (atoi (substr (ver) 13)) 2011)
        (progn
            (alert "This routine require AutoCAD 2011 or higher.")
            (exit)
        )
    )
)

;****************************************************************************

(defun <sel> (<msg> / *poly* *esel* *p*)
    (while (not *poly*)
        (setvar "errno" 0)
        (setq *esel* (entsel <msg>))
        (setq *poly* (car *esel*))
        (setq *p* (cadr *esel*))
        (if (= 7 (getvar 'errno))
            (alert "No objects selected")
        )
        (if (= 'ename (type *poly*))
            (cond
                ( (null (wcmatch (cdr (assoc 0 (entget *poly*))) "LWPOLYLINE"))
                  (alert "Invalid selection, the object is not a LWPOLYLINE.")
                  (setq *poly* nil)
                )
                ( (= 1 (logand 1 (cdr (assoc 70 (entget *poly*)))))
                  (alert "Invalid selection, the polyline is not open.")
                  (setq *poly* nil)
                )
            )
        )
    )
    (list *poly* *p*)
)

;****************************************************************************

(defun check_elev ()
    (if
        (not
            (equal
                (cdr (assoc 38 (entget :e1)))
                (cdr (assoc 38 (entget :e2)))
                1e-6
            )
        )
        (progn
            (alert "Polylines have different elevation.")
            (exit)
        )
    )
)

;****************************************************************************

(defun check_normal ()
    (if
        (or
            (not (equal (cdr (assoc 210 (entget :e1))) '(0.0 0.0 1.0) ))
            (not (equal (cdr (assoc 210 (entget :e2))) '(0.0 0.0 1.0) ))
        )
        (progn
            (alert "Polyline is not normal to the WCS.")
            (exit)
        )
    )
)

;****************************************************************************

(defun e_next (entL mode / next)
    (if (= mode "SS") (setq next (ssadd)))
    (if (/= entL (entlast))
        (while (setq entL (entnext entL))
       	    (if (entget entL)
                (cond
                    ( (= mode "LS") (setq next (cons entL next)) )
                    ( (= mode "SS") (setq next (ssadd entL next)) )
                )
            )
        )
    )
    next
)

;****************************************************************************

(defun check_offset ( / o_del)
    (if rip (setq rip (1+ rip)) (setq rip 1))
    (if (> (length (setq o_del (e_next EL "LS"))) 1)
        (progn
            (entdel e1)
            (entdel e2)
            (if (= rip 2) (entdel e1o))
            (mapcar
               '(lambda (x)
                    (if (not (vlax-erased-p x)) (entdel x))
                )
                o_del
            )
            (alert
                (strcat
                    "Modeling failed."
                    "\nTry to split the polylines into more portions."
                )
            )
            (exit)
        )
    )
)

;****************************************************************************

(defun MaxDist (ent1 ent2 / :step De1 :div p_step :D Dmax)
    (setq :step (/ (setq De1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500))
    (setq :div :step)
    (setq Dmax 0.00)
    (while (< :div De1)
        (setq p_step (vlax-curve-getPointAtDist ent1 :div))
        (setq :D (distance p_step (vlax-curve-getClosestPointTo ent2 p_step)))
        (if (> :D Dmax) (setq Dmax :D))
        (setq :div (+ :div :step))
    )
    Dmax
)

;****************************************************************************

(vl-load-com)

(prompt "\n ") (prompt "\n ")
(princ "\nCenterline between two polyline - by Gian Paolo Cattaneo")
(princ "\ncenterPline.LSP loaded ............... Type \"CPL\" to run ")
(princ)

 

[enthralled]

Without excluding "(if (null ETmsg) (check_ET))", I got it to work just by adding the following 2 lines at the beginning, :

 

(load "acettest.fas")
(load "acetauto.lsp")

 

As suggested in the following post:
https://forums.autodesk.com/t5/installation-licensing/error-no-function-definition-acet-autoload2/m-p/12946755/highlight/true#M279008

 

Maybe there's something wrong with my AutoCAD installation. But it's working for now.

Thanks.

[GP_]

5 hours ago, enthralled said:

(load "acettest.fas")
(load "acetauto.lsp")

 

It's good to know. 

Edited September 10 by GP_