Attempt number 2:
This code is intended to always return a centerline whose points are all perfectly equidistant from the margins.
This should happen in all cases where two LWPOLYLINEs are provided, one for each margin.
The case of islands has not been considered yet.
The resulting centerline is geometrically dense. This can probably be simplified in a future version.
The approach taken in this code has been to obtain points from the normals and the bisectors of each margin, which are then combined at the end to build a list of points.
Therefore, it is a fragmentary and massive approach. For this reason, the code is not very fast.
However, there is another, more elegant approach, based on dynamically relating the geometry of both margins.
It is more complex, but it would also be faster, and the error margins would be “bridgable”.
If this thread has enough life in it, I may feel sufficiently motivated to finish it.
That’s all for now.
;|*********************** CENTER-LINE *************************
************************ G L A V C V S *************************
************************** F E C I T *************************** |;
(defun c:CLG (/ PI/2 lst e1 e2 l1 l2 lp lp1 lp2 p0 p> p< r1? x m a tol autoInt? ordenaPts interCpta ptEqd)
(defun autoInt? (l lp / p0 p1 p2);autointersecci贸n?
(if l
(setq p1 (polar (car l) (setq a (angle (car l) (cadr l))) 0.001) p2 (polar (cadr l) (+ a PI) 0.001)
x (if (not (vl-some '(lambda (p) (if p0 (inters p0 (setq p0 p) p1 p2) (not (setq p0 p)))) lp)) l)
)
)
)
(defun ordenaPts (lst / pIni dm d ps? ps lr); puntos en orden
(setq pIni (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (car lp2)))
(while lst
(foreach p lst
(if (and dm (/= (min (setq d (distance (if ps ps pIni) p)) dm) dm))
(setq dm d ps? p)
(if (not dm) (setq dm (distance (if ps ps pIni) p) ps? p))
)
)
(setq ps ps? ps? nil dm nil lst (vl-remove ps lst) lr (cons (cadr ps) (cons (car ps) lr)))
)
lr
)
(defun interCpta (pM p1 p2 lp / i? i1 i2 d a b); captura de los m谩rgenes
(defun i? (pA pB lp / p0 i dm is a)
(foreach p lp
(if p0
(if (setq i (inters p0 (setq p0 p) pA pB))
(if (and dm (/= (min (setq d (distance pM i)) dm) dm))
(setq dm d is i)
(if (not dm) (setq dm (distance pm i) is i))
)
)
)
(setq p0 p)
)
(if is (list (car is) (cadr is) 0.0))
)
(if (and (setq a (i? p1 p2 lp1)) (setq b (i? p1 p2 lp2)))
(list a b)
)
)
(defun ptEqd (A B e1 e2 / eqDist-f t0 t1 f0 f1 tm fm n i v+- v*); captura punto equidistante
(defun v+- (o a b) (mapcar o a b))
(defun v* (p s) (mapcar '(lambda (x) (* x s)) p))
(defun eqDist-f (ds A B e1 e2 / pt d1 d2)
(setq pt (v+- '+ A (v* (v+- '- B A) ds)); Punto sobre AB: P(ds) = A + ds (B - A)
d1 (distance pt (vlax-curve-getClosestPointTo e1 pt))
d2 (distance pt (vlax-curve-getClosestPointTo e2 pt))
)
(- d1 d2)
)
(setq t0 0.0 t1 1.0)
(while (and (< (setq n (if n (1+ n) 0)) 100) (> (- t1 t0) 1e-6));m茅todo de bisecci贸n
(setq tm (/ (+ t0 t1) 2.0)
fm (eqDist-f tm A B e1 e2)
)
(if (< (abs fm) 1e-9)
(setq n 100 t1 tm t0 tm)
(if (< (* (if f0 f0 (eqDist-f t0 A B e1 e2)) fm) 0.0)
(setq t1 tm f1 fm)
(setq t0 tm f0 fm)
)
)
)
(if (< t1 1.0) ; par谩metro final y punto equidistante
(v+- '+ A (v* (v+- '- B A) (/ (+ t0 t1) 2.0)))
)
)
(if (and (setq e1 (car (entsel "\nSelect FIRST LWPolyline..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") )
(if (and (setq e2 (car (entsel "\nSelect SECOND LWPolyline..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") )
(progn
(foreach l l1 (if (= (car l) 10) (setq lp1 (cons (cdr l) lp1))))
(foreach l l2 (if (= (car l) 10) (setq lp2 (cons (cdr l) lp2))))
(setq r1? (> (distance (car lp1) (car lp2)) (distance (car lp1) (last lp2))))
(setq tol 0.01 PI/2 (/ PI 2.) lp1 (if r1? (reverse lp1) lp1))
(foreach e (list e1 e2)
(setq p0 nil m nil r? (if (equal e e1) r1?) lp (if (equal e e1) lp2 lp1))
(while (setq p (vlax-curve-getPointAtParam e (setq m (if m ((if r? 1- 1+) m) (if r? (vlax-curve-getEndParam e) 0)))))
(if p0
(progn
(setq lAB (autoInt? (interCpta p (polar p (setq a (+ (angle p0 p) PI/2)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2));NORMAL AL COMIENZO DEL SEGMENTO
lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst)
)
(if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m)))
(setq lAB (autoInt? (interCpta p (polar p (setq a (/ (+ (angle p p0) (angle p p>)) 2.)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2)) ; Bisectriz
lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst)
lAB (autoInt? (interCpta p (polar p (setq a (+ (angle p p>) PI/2)) 10000) (polar p (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2));NORMAL AL FINAL DEL SEGMENTO
lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst)
)
)
(setq p< p0 p0 p)
)
(if (setq p> (vlax-curve-getPointAtParam e ((if r? 1- 1+) m)))
(setq lAB (autoInt? (interCpta p (polar (setq p0 p) (setq a (+ (angle p0 p>) PI/2)) 10000) (polar p0 (+ a PI) 10000) lp) (if (equal e e1) lp1 lp2))
lst (if lAB (cons (ptEqd (car lAB) (cadr lAB) e1 e2) lst) lst)
)
)
)
)
)
(vla-AddLightWeightPolyline
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(vlax-Make-Variant (vlax-SafeArray-Fill (vlax-Make-SafeArray 5 (cons 0 (- (length (setq lst (reverse (ordenaPts lst)))) 1))) lst))
)
)
)
)
(princ)
)