Leaderboard

Greetings to all members of Cad Tutor, Based on the upcoming holidays and New Year, I'v made something interesting which I want it to share with you. Everything was made using a Lisp. I hope it will interesting to all of you and maybe give some inspiration to the next year to made something different and share it with rest of us . Notice (it is on cyrillic, in Serbian language): - ЗИМСКА СЛУЖБА = Winter service on roads; - СРЕЋНА НОВА ГОДИНА = HAPPY NEW YEAR; - XO-XO-XOO = HO-HO-HOO (). Happy New Year 2026 to all members, and wish you all the best and new codes . NovaGodina2026_CadTutor.mp4 Best regards, Saxlle.

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) )

I'm interested in where this topic will be going with the different "side quests" like islands and inlets. In the mean time I kept going, trying to fix my version and after a lot of testing/debugging I changed to code again. Now it is working as expected on all of the examples I have found! ;| ; Calculate centerline between two polylines - dexus ; Function checks intersections of the offsets of two lines to create a middle/avarage line. ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/7/#findComment-677877 ; Version / Date - Change ; 0.01 [19-11-2025] - Initial release ; 0.02 [27-11-2025] - Added corner support on negative side of crossing polylines ; 0.03 [28-11-2025] - Extra check using vertex to closest point as distance ; 0.04 [28-11-2025] - Added error function ; 0.05 [01-12-2025] - Improved distance check to prevent zigzag lines ; 0.06 [01-12-2025] - Check if offset can be used before adding points ; 0.07 [01-12-2025] - Improved side check on 3 points ; 0.08 [04-12-2025] - Don't compare startpoint to offset when eiter of the polylines is closed ; 0.09 [05-12-2025] - Add points for parallel end segments ; 0.10 [18-12-2025] - More checks for deleting lines and added dedicated function ; 0.11 [08-01-2026] - Support for multiple output lines of the offset function ; 0.12 [08-01-2026] - Bulges are transformed to lines to handle cocentric arcs ; 0.13 [08-01-2026] - Rewrote the _avarageAngle and _diffAngle function |; (defun c:cl (/ corners ent1 ent2 gap index loop maxlen offset offsetdistance org1 org2 parallel pts sides ss start te0 te1 te2 tmp1 tmp2 LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _checkOffset _checkSortDirection _copyPolyline _cornerOffset _deleteTmpLine _diffAngle _doOffset _getAnglesAtParam _polyline _side *error*) (defun *error* (st) (if (wcmatch (strcase st t) "*break,*cancel*,*exit*") (redraw) (princ (strcat "\nOops! Something went wrong: ") st) ) (mapcar '_deleteTmpLine (list ent1 ent2 te0 te1 te2)) (princ) ) ;| ; Deletes an object or list of objects ; @Param obj vla-object or list |; (defun _deleteTmpLine (obj) (cond ((null obj)) ((vl-catch-all-error-p obj)) ((= (type obj) 'list) (mapcar '_deleteTmpLine obj)) ((not (vlax-erased-p obj)) (vla-delete obj)) ) ) ;| ; Draw Polyline - dexus ; Draw a polyline from a list of points, but filter out colinear points ; @Param lst list of points ; @Returns ename of polyline |; (defun _polyline (lst closed / prev pts) (while lst (cond ( (and (cdr lst) prev (or (equal (cdr lst) prev 1e-8) ; Remove duplicate points (null (inters prev (car lst) prev (cadr lst))) ; Remove collineair points ) ) ) ((setq pts (cons (cons 10 (setq prev (car lst))) pts))) ) (setq lst (cdr lst)) ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 (if closed 1 0)) ) (reverse pts) ) ) ) (defun _copyPolyline (ent maxlen closed rev / bul pts index curve steps size next) (setq ent (vlax-ename->vla-object ent) index 0) (repeat (1+ (fix (vlax-curve-getEndParam ent))) (cond ( (and (not (vl-catch-all-error-p (setq bul (vl-catch-all-apply 'vla-getbulge (list ent index))))) (not (equal bul 0.0 1e-8)) (setq next (vlax-curve-getDistAtParam ent (1+ index))) (not (zerop (setq steps (fix (* (/ (- next (vlax-curve-getDistAtParam ent index)) maxlen) 45))))) ) (setq size (/ 1.0 steps) curve index) (repeat steps (setq pts (cons (vlax-curve-getPointAtParam ent curve) pts) curve (+ curve size)) ) ) ((setq pts (cons (vlax-curve-getPointAtParam ent index) pts))) ) (setq index (1+ index)) ) (_polyline (if rev (reverse pts) pts) closed) ) (defun _side (pline pnt / cpt end target der) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 (setq cpt (vlax-curve-getClosestPointTo pline pnt) end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar '- (polar cpt (angle '(0 0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) '(0 0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der)))) ) ;; Intersections - Lee Mac ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst)) ) ) (reverse rtn) ) (defun _doOffset (offset / lst rtn) ; Global vars: pts ent1 ent2 sides te1 te2 (setq rtn (cond ((equal offset 0.0 1e-8) (if (setq lst (LM:intersections ent1 ent2 acExtendNone)) (setq pts (_addPoints lst ent1 ent2 pts)) ) lst ) ( (or ; Make offset (setq te1 nil) (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if (car sides) offset (- offset)))))) (not (setq tmp1 (vl-some (function (lambda (te) (_checkOffset ent1 te offset))) te1))) (vla-put-visible tmp1 :vlax-false) ; (vla-put-color tmp1 252) (setq te2 nil) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if (cadr sides) offset (- offset)))))) (not (setq tmp2 (vl-some (function (lambda (te) (_checkOffset ent2 te offset))) te2))) (vla-put-visible tmp2 :vlax-false) ; (vla-put-color tmp2 252) ) (princ (strcat "\nOffset of " (rtos offset 2 4) " failed. ")) nil ) ((setq lst (LM:intersections tmp1 tmp2 acExtendNone)) (if parallel ; Add points of parallel end segments (mapcar (function (lambda (ent1 ent2) (mapcar (function (lambda (pt) (if (equal pt (vlax-curve-getClosestPointTo ent2 pt) 1e-10) (setq lst (cons pt lst)) ) )) (list (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent1) ) ) )) (list tmp1 tmp2) (list tmp2 tmp1) ) ) (setq pts (_addPoints lst tmp1 tmp2 pts)) lst ) ) ) (_deleteTmpLine te1) (_deleteTmpLine te2) rtn ) ;| ; Check if the offset starts and ends at the correct point or is closed |; (defun _checkOffset (ent1 ent2 offset) (if (or (vlax-curve-isclosed ent1) (vlax-curve-isclosed ent2) (and (equal (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getStartPoint ent2)) offset 1e-4) (equal (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) offset 1e-4) ) ) ent2 ) ) (defun _addPoints (lst ent1 ent2 pts / len1 len2) (setq len1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1)) len2 (vlax-curve-getDistAtParam ent2 (vlax-curve-getEndParam ent2)) lst (vl-remove nil (mapcar (function (lambda (pt / d1 d2) (if (and (setq d1 (vlax-curve-getDistAtPoint ent1 pt)) (setq d2 (vlax-curve-getDistAtPoint ent2 pt)) ) (list (cons ( (lambda (ang) (if (cadr ang) (_avarageAngle (car ang) (cadr ang)))) (mapcar (function (lambda (ent) ( (lambda (ang) (if (cadr ang) (_avarageAngle (car ang) (cadr ang)))) (_getAnglesAtParam ent (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointTo ent pt))) ) )) (list ent1 ent2) ) ) (cond ((and (vlax-curve-isclosed ent1) (not (vlax-curve-isclosed ent2))) (list (/ d2 len2))) ((vlax-curve-isclosed ent2) (list (/ d1 len1))) ((list (/ d1 len1) (/ d2 len2))) ) ) pt ) ) )) lst ) )) (append lst pts) ) ;| ; Project Point onto Line - Lee Mac ; @Param pt point to project ; @Param p1 first point of line ; @Param p2 second point of line ; @Returns projected point |; (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm)) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) (defun _getAnglesAtParam (ent pa / ang1 ang2) (if (and (vlax-curve-isClosed ent) (= pa 0)) ; Special case for closed Polyline (setq ang1 (vlax-curve-getFirstDeriv ent 1e-14) ang2 (vlax-curve-getFirstDeriv ent (- (fix (vlax-curve-getEndParam ent)) 1e-14))) (setq ang1 (vlax-curve-getFirstDeriv ent (+ pa 1e-14)) ang2 (vlax-curve-getFirstDeriv ent (- pa 1e-14))) ) (if (and ang1 ang2) (list (angle '(0 0 0) ang1) (angle '(0 0 0) ang2) ) ) ) ;| ; Avarage Angle - dexus ; Get angle of a line between two angles ; @Param ang1 real - Angle in radians ; @Param ang2 real - Angle in radians ; @Returns real - Angle in radians |; (defun _avarageAngle (ang1 ang2 / dif) (setq dif (- ang1 ang2)) (if (< pi (abs dif)) (+ ang1 (* (- (+ pi pi) (abs dif)) (if (minusp dif) -0.5 0.5) ) ) (+ ang2 (* dif 0.5)) ) ) ;| ; Difference between angles - dexus ; Retuns the angle between two angles ; @Param ang1 real ; @Param ang2 real ; @Returns real |; (defun _diffAngle (ang1 ang2) ( (lambda (ang) (if (> ang pi) (- (+ pi pi) ang) ang ) ) (abs (- ang2 ang1)) ) ) ;| ; Check which of two poits is closer to the expected angle of the line ; @Param a (list (list angle) point) ; @Param b (list (list angle distance1 distance2) point) ; @Returns true if a is after b |; (defun _checkSortDirection (a b) (and (caar a) (caar b) (< (abs (_diffAngle (angle (cadr a) (cadr b)) (caar a))) (abs (_diffAngle (angle (cadr b) (cadr a)) (caar b))) ) ) ) ;| ; Calculate exact offset distance on a corner - dexus ; pt1 - Point on corner ; pt2 - Point on other side ; pt3 - Center for bisector ; pt4 - Target for corner of the offset ; pt5 - Find perpendicular point for offset distance ; / ; / ; -------- pt1 pt5 ; \ / ; pt4 ; \ ; ---- pt3 ----- pt2 ----- ; ; @Param ent1 Line to check corners ; @Param ent2 Opposing line ; @Returns List of offset distances (pt1 -> pt5) to calculate |; (defun _cornerOffset (ent1 ent2 / ang1 ang1a ang2 ang3 index pt1 pt2 pt3 pt4 pt5 rtn) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (and (setq pt1 (vlax-curve-getPointAtParam ent1 index)) ; Point on corner (setq ang1 (_getAnglesAtParam ent1 index)) ; Angles of pt1 (setq ang1a (_avarageAngle (car ang1) (cadr ang1))) (setq te0 (entmakex (list (cons 0 "line") (cons 10 pt1) (cons 11 (polar pt1 (- ang1a halfPi) 1))))) ; Temp line for finding the angle on the other side (foreach pt2 (LM:intersections (vlax-ename->vla-object te0) ent2 acExtendThisEntity) ; Point on other side (and (setq ang2 (_getAnglesAtParam ent2 (vlax-curve-getParamAtPoint ent2 pt2))) ; Angle of pt2 (if (equal (rem (car ang1) pi) (rem (car ang2) pi) 1e-8) ; Is parallel? (and (setq parallel (or parallel (< index 1) (<= (fix (vlax-curve-getEndParam ent1)) (1+ index)) t)) ; End of line is parallel (setq pt3 (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt1 pt2)) ; Midpoint (setq ang3 (car ang1)) ; Same angle als ang1 ) (and (setq pt3 (inters pt1 (polar pt1 (car ang1) 1) pt2 (polar pt2 (car ang2) 1) nil)) ; Find center for bisector (setq ang3 (_avarageAngle (angle pt1 pt3) (angle pt2 pt3))) ; Angle of bisector ) ) (setq pt4 (inters pt3 (polar pt3 ang3 1) pt1 (polar pt1 (+ ang1a halfPi) 1) nil)) ; Find target for corner of the offset (setq pt5 (LM:ProjectPointToLine pt4 pt1 (polar pt1 (+ (car ang1) halfPi) maxlen))) ; Find perpendicular point for offset distance (setq rtn (cons (distance pt1 pt5) rtn)) ; Return offset distance ) ) ) (if (and te0 (not (vlax-erased-p te0))) (entdel te0)) (setq index (1+ index)) ) rtn ) (if (and (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") nil ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq org1 (ssname ss 0)) (setq org2 (ssname ss 1))) nil ; Stop loop ) ) ) ) org1 org2 ) (progn (if (not (numberp halfPi)) (setq halfPi (* pi 0.5))) (setq maxlen (* 1.1 (max (vlax-curve-getDistAtParam org1 (vlax-curve-getEndParam org1)) (vlax-curve-getDistAtParam org2 (vlax-curve-getEndParam org2)) ( (lambda (ent1 ent2 / step de1 div p_step dis dmax) (setq step (/ (setq de1 (vlax-curve-getDistAtParam ent1 (vlax-curve-getEndParam ent1))) 500) div step dmax 0.0) (while (< div de1) (setq p_step (vlax-curve-getPointAtDist ent1 div) dis (distance p_step (vlax-curve-getClosestPointTo ent2 p_step))) (if (> dis dmax) (setq dmax dis)) (setq div (+ div step)) ) dmax ) org1 org2 ) ) ) ) ; Convert first line (setq ent1 (_copyPolyline org1 maxlen (vlax-curve-isClosed org1) nil)) (setq ent1 (vlax-ename->vla-object ent1)) (vla-put-visible ent1 :vlax-false) ; Convert second line (setq ent2 (_copyPolyline org2 maxlen (vlax-curve-isClosed org2) (< (distance (vlax-curve-getStartPoint org1) (vlax-curve-getEndPoint org2)) (distance (vlax-curve-getEndPoint org1) (vlax-curve-getEndPoint org2)) ) )) (setq ent2 (vlax-ename->vla-object ent2)) (vla-put-visible ent2 :vlax-false) ; Get offset direction (setq sides (mapcar (function (lambda (a b / s m e) (setq s (_side a (vlax-curve-getStartPoint b)) m (_side a (vlax-curve-getPointAtParam b (* 0.5 (vlax-curve-getEndParam b)))) e (_side a (vlax-curve-getEndPoint b))) (or (and s m) (and s e) (and m e)) )) (list ent1 ent2) (list ent2 ent1) ) ) (mapcar ; Add half distances from closest point to every vertex (function (lambda (ent1 ent2 / index pt) (setq index 0) (repeat (fix (vlax-curve-getEndParam ent1)) (setq pt (vlax-curve-getPointAtParam ent1 index) corners (cons (* (distance pt (vlax-curve-getClosestPointTo ent2 pt)) 0.5) corners) index (1+ index)) ) )) (list ent1 ent2) (list ent2 ent1) ) (setq corners (vl-sort (append corners (_cornerOffset ent1 ent2) (_cornerOffset ent2 ent1)) '<) offsetdistance (/ maxlen 256.0)) (if (LM:intersections ent1 ent2 acExtendNone) ; For crossing polylines, add negative values (setq offset (- maxlen) corners (append (mapcar '- (reverse corners)) corners)) (setq offset 0.0) ) (setq index 0) (setq gap (getvar 'offsetgaptype)) (setvar 'offsetgaptype 0) (while (progn (while (and corners (> offset (car corners))) ; Calculated offset values to check (_doOffset (car corners)) (setq index (1+ index)) (setq corners (cdr corners)) ) (setq loop ; Incremental check (cond ((> offset maxlen) nil) ((_doOffset offset) (setq index (1+ index)) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (setvar 'offsetgaptype gap) (if pts ; Draw polyline (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b / ang) (if (and (caddar a) (caddar b)) (if (< (cadar a) (cadar b)) (or (< (caddar a) (caddar b)) (_checkSortDirection a b)) (and (< (caddar a) (caddar b)) (_checkSortDirection a b)) ) (< (cadar a) (cadar b)) ) )) ) ) (and (vlax-curve-isClosed ent1) (vlax-curve-isClosed ent2) ) ) ) (_deleteTmpLine ent1) (_deleteTmpLine ent2) (if (and ent2 (not (vlax-erased-p ent2))) (vla-delete ent2)) ) ) (princ) ) River result:

Their IT department even has a slogan (and I'm not kidding here) : You name it , we block it

The reason I clean the drawing is I once wrote a program to generate instrument loop diagrams from an excel file. I found the most stable and easy way was not to use a script but stay in the current drawing and from there save(as) each loop. I also made use from templates and also had the option to update the drawing in stead of generating the entire drawing. But at some time some templates had been given an update to a block definition and to be certain the latest version was used I had to make sure the old block was purged. Overkill , some times yes , but in my case it worked as it should. In this case , dxfin , probably overkill , but it doesn't hurt either. I tested it on Bricad 22 and the dwg extension was no problem, it worked as it should. The recommendation from the annoying paperclip oh , sorry , AI its called these days , to pimp the filename and use vla-saveas is not wrong though. Just didn't need it on my computer. Had it gave me an error I would have fixed it but it worked right from the start for me.

Obviously, this has now become something more than just the search for a solution to a single user’s problem. First of all, I should say that I myself was also reluctant to accept the concept of equidistance advocated by @GP_ and @dexus For the simple reason that applying this principle forced me to accept that the centerline should be the same in these two drawings. Equidistance requires ignoring those areas of the margins that do not geometrically affect the axis. This, which initially caused me some resistance, I eventually came to accept conceptually when I realized that it could serve as a criterion for defining what is a “recodo/inlet” and what is not. So I have abandoned my previous approach and adapted it to this new situation. Having made this clarification, I must say that this concept of equidistance makes the calculation of a centerline more feasible. I’ve been running some tests with Dexus’s latest code, which is the best so far. However, I’ve discovered some “holes” that I hadn’t noticed before. I’m attaching a few images showing this. In my view, these are conceptual errors rather than geometric limitations. And what can we consider “geometric limitations”? I believe that, in any case, every vertex of the centerline must be equidistant from both margins. If this is not the case, the result is not correct. However, the intermediate regions along each segment may be subject to geometric limitations depending on the desired precision. Therefore, in bends or turns, the points taken within the adjustment or “problematic” segments may deviate (within a tolerance) from strict equidistance. The goal, therefore (in my opinion), should be to achieve equidistance at every vertex and to remain within a tolerance in the intermediate zone of each segment. After everything written here so far, some might wonder: is it really possible to obtain a centerline that meets these requirements? As far as I’m concerned, I’m running some tests. GusanoAcad.mp4 I’ll post something over the weekend

Another - (defun c:test ( / e i s x ) (if (setq s (ssget "_X" '((0 . "LINE")))) (repeat (setq i (sslength s)) (setq i (1- i) e (ssname s i) x (entget e) ) (if (not (equal (cadr (assoc 10 x)) (cadr (assoc 11 x)) 1e-8)) (ssdel e s) ) ) ) (sssetfirst nil s) (princ) )

This version should work in all cases, regardless of the complexity of the polygons ;******************* p o r d e s i a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:RectOffBatch (/ selset dist i ent pts offsetpt a70 es l le p1 p2 o sDir) (defun sDir (le i? / p1 p2 p ar ang ab dir tl) (foreach l le (if (and (= (car l) 10) (setq p (cdr l))) (progn (if p2 (if p1 (setq dir (cond ((< (abs (setq ang (- (setq ar (angle p1 p2)) (setq ab (angle p2 p))))) PI) ang) (T (if (<= ar PI) (+ ar (- (* 2 PI) ab)) (- (- ar (* 2 PI)) ab))) ) ) ) ) (if dir (setq tl (+ (if tl tl 0) dir))) (setq p1 p2 p2 p dir nil) ) ) ) (if (minusp tl) (if i? + -) (if i? - +)) ) (prompt "\nSelect rectangles (polylines): ") (setq selset (ssget '((0 . "*POLYLINE")))) (vl-cmdf "_.CONVERTPOLY" "_Light" selset "") (if selset (if (setq i -1 dist (getdist "\nEnter the offset distance: ")) (repeat (sslength selset) (setq ent (ssname selset (setq i (1+ i)))) (setq o (sDir (setq le (entget ent)) nil)); <-- CHANGE 'nil' TO 'T' FOR OFFSET INWARD TOWARD INTERIOR OF THE POLYGONS (if (= (rem (cdr (setq a70 (assoc 70 le))) 2) 0) (entmod (subst (cons 70 (+ (cdr a70) 1)) a70 le))) (setq pr (vlax-curve-getPointAtParam ent 0.5)) (setq offsetpt (polar pr (o (angle (vlax-curve-getPointAtParam ent 0) pr) (/ PI 2.)) 0.1)) (command "_.OFFSET" dist ent offsetpt "") ) ) ) (princ) )

I'll this topic a "wrap" Thanks to all here! rlx: I also have worked at my last company of fifteen years within a very locked down IT environment. Here and now, I am free! One caveat here is that there are limitations in acquiring additional Microsoft tools i.e., Power Platform tools, etc. due to the complexity introduced from being a client of an widely known commercial web hosting service. Happy, happy, happy! Clint

Yikes! Working with your arms tied.. No way I could work effectively without my tools, I would at least need autohotkey. Last company I worked for, I automated their whole system, mostly because I was lazy and I wanted to eat donuts all day. AutoCAD ships with .NET, nothing to install, I would be rolling some goodies for sure. “We At ACME corporation stifle innovation by making everyone think inside the box”

Use this and simply switch: *dist* (- *dist*) To: (- *dist*) *dist*

@Danielm103 ""with mtext, you have to use a fixed width font" I agree, Monotxt.sHx I think was what I used. monotxt_.ttf EXTRA FONTS A-Z.txt Banner heading3.lsp

I think with those big side offshoots you need to break the river into multiple plines so you would have two or more centrelines lines in that situation. As suggested by @SLW210 The problem will be how to work out the break offset shape.. Ps image dummied up.

This should achieve the desired result without overriding nested width formatting - (defun c:mtw ( / enx idx sel str wid ) (initget 6) (cond ( (not (setq wid (getreal "\nSpecify new width factor: ")))) ( (setq sel (ssget "_:L" '((0 . "MTEXT")))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) enx (entget (ssname sel idx)) str (assoc 1 enx) ) (entmod (subst (cons 1 (addupdatewidth (cdr str) wid)) str enx)) ) ) ) (princ) ) (defun addupdatewidth ( str wid / ps1 ps2 ps3 ) (cond ( (= "" str) str) ( (and (setq ps1 (vl-string-search "{\\W" str)) (setq ps2 (vl-string-search ";" str ps1)) (setq ps3 (vl-string-search "}" str ps2)) ) (strcat (addupdatewidth (substr str 1 ps1) wid) (substr str (1+ ps1) 3) (rtos wid 2) (substr str (1+ ps2) (- ps3 ps2 -1)) (addupdatewidth (substr str (+ ps3 2)) wid) ) ) ( (strcat "{\\W" (rtos wid 2) ";" str "}")) ) ) (princ)

This was my 'Offset Inside' program: ;; Offset Inside - Lee Mac - www.lee-mac.com ;; Offsets a set of objects by a specified distance to the inside. (defun c:OffInside ( / acsel pos ) (if (and (setq *dist* (cond ( (getdist (strcat "\nOffset Distance" (if *dist* (strcat " <" (rtos *dist*) ">: ") ": ") ) ) ) ( *dist* ) ) ) (ssget '( (-4 . "<OR") (0 . "CIRCLE,ARC,ELLIPSE") (-4 . "<AND") (0 . "LWPOLYLINE,SPLINE") (-4 . "&=") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "POLYLINE") (-4 . "&=") (70 . 1) (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) ) ) (progn (vlax-for obj (setq acsel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)) ) ) (vl-catch-all-apply 'vla-offset (list obj (if (and (setq pos (vl-position (vla-get-objectname obj) '("AcDbPolyline" "AcDb2dPolyline"))) (LM:ListClockwise-p (LM:GroupByNum (vlax-get obj 'coordinates) (+ pos 2))) ) *dist* (- *dist*) ) ) ) ) (vla-delete acsel) ) ) (princ) ) ;; List Clockwise-p - Lee Mac ;; Returns T if the point list is clockwise oriented (defun LM:ListClockwise-p ( lst ) (minusp (apply '+ (mapcar (function (lambda ( a b ) (- (* (car b) (cadr a)) (* (car a) (cadr b))) ) ) lst (cons (last lst) lst) ) ) ) ) ;; Group by Number - Lee Mac ;; Groups a list into a list of lists, each of length 'n' (defun LM:GroupByNum ( l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (LM:GroupByNum l n) ) ) ) (vl-load-com) (princ)

Just use: (command "_.OFFSET" dist ent "_non" offsetpt "") And you no longer need to worry about OSMODE.

You would still need Visual Studio or similar and packages installed. Even for Visual Studio Code and LISP, I get PowerShell errors due to IT blocking it as well as the need to download the extension. Main issue is just lazy IT departments not wanting to due proper security, every issue I have had a work shows "improper server configuration" and/or "improper firewall configuration" when searching the issue. Anyone using Autodesk products (maybe other programs as well) has to manually override the proxy server on each restart of their computer or we have licensing issues. I had to to do all of the leg work on getting that issue resolved. Unfortunately that's just how many IT "professionals" are trained, "when in doubt, block it out". I normally don't have issues getting programs installed, just usually they are in no hurry to get it done. Autodesk is partly to blame, should be a better way to get apps, add-ons, etc. than needing an IT install. Even Microsoft, why do I need to update Windows and MS Office tools separately and need IT to allow use of PowerShell? To be honest though, I am just the AutoCAD guy, so they don't understand how programming with other tools is relevant.

If you want to change the offset direction, you just need to change the 'i?' parameter used to call 'sDir' from 'nil' to 'T' (as indicated in the code comment). Nikon2.mp4 PS: The video shows the execution of the code with 'i?' set to 'T'.

I tested the code on your drawing and it works correctly. Perhaps you didn't use it correctly. Nikon1.mp4

For most things I do this is my default option, rarely need to do much other than that and if I do, drag and drop.

There's an app for that: https://apps.autodesk.com/ACD/en/Detail/Index?id=3434696327413675915&appLang=en&os=Win32_64

new to Bricad but this seems to work : (defun c:DxfToDwg ( / actDoc dxf-folder dxf-list ) (setq actDoc (vla-get-activedocument (vlax-get-acad-object))) (vl-load-com) (cond ((not (setq dxf-folder (_getfolder "Select folder with dxf files"))) (princ "\nNo folder selected")) ((not (vl-consp (setq dxf-list (_getfiles dxf-folder "*.dxf")))) (princ (strcat "\nNo dxf files in folder " dxf-folder))) (t (command ".undo" "mark")(setvar "expert" 2) (foreach dxf dxf-list (command ".erase" "all" "") (vla-purgeall actDoc) (vl-cmdf "_.dxfin" dxf) (vla-ZoomExtents (vlax-get-acad-object)) (command ".save" (strcat (vl-filename-directory dxf) "\\" (vl-filename-base dxf))) ) (command ".undo" "back") ) ) (princ) ) ; generic getfolder routine with possibility to create a new subfolder (_getfolder "select path") (defun _getfolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (vl-string-translate "\\" "/" f))) (defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x))))) (defun _getfiles ( fol ext / lst) (cond ((or (void fol) (not (vl-file-directory-p fol))) (princ (strcat "\nInvalid folder :" (vl-princ-to-string fol)))) (t (if (vl-consp (setq lst (vl-directory-files fol ext 1))) (setq lst (mapcar '(lambda (x)(strcat fol "/" x)) lst)))) ) lst )

Most of the members here have real jobs as well and provide help as their own busy schedules allow. I do not believe anyone was being rude, just nudging you along to do a little work for yourself.

I have done something like this a couple of years ago :

with mtext, you have to use a fixed width font import traceback from pyrx import Ap, Db, Ed import art @Ap.Command() def doit(): try: db = Db.curDb() mt = Db.MText() mt.setDatabaseDefaults() val = art.text2art("Sup Dude!", font="big", sep ="\\P") mt.setContents("{\\Fmonotxt8|c0;" + val + "}") db.addToModelspace(mt) except Exception as err: traceback.print_exception(err)

I have to agree with Bigal about to (new)bee or not to (new)bee but to give you an idea ; (setq val (getentitytransparency (car (entsel)))) (defun getentitytransparency ( ent ) (cond ((= 'vla-object (type ent))(vla-get-entitytransparency ent)) ((= 'ename (type ent))(getentitytransparency (vlax-ename->vla-object ent))))) ; (< lower-limit test-number upper-limit) ; (putentitytransparency (car (entsel)) "ByBlock") (putentitytransparency (car (entsel)) 100) (defun putentitytransparency (e v / i o) (cond ((null v)(setq v "ByLayer"))((and (numberp v)(< 0 v 90))(setq v (itoa (fix v)))) ((and (= (type v) 'STR) (distof v) (>= 0 (setq i (fix (distof v))) 90))(setq v (itoa i))) ((and (= (type v) 'STR) (member (strcase v t)'("bylayer" "byblock"))) v)(t (setq v "0"))) (if (setq o (e->o e))(vla-put-entitytransparency o v)))

@mhupp do you want a lisp version of that ? It works same way uses "*". I think it was 1990.s used it as header in lisp programs.

I post the 3d house image often and a version of that software was available for Intellicad back in the 90's, there was no VL lisp in those days. It was very good then and seen as a competitor to LT,

Some really cool stuff here

test with wxPython

Note that you can use my Layer Director to preset & reset a layer (including layer creation) for both standard and custom commands: https://lee-mac.com/layerdirector.html

See on archive of the web: UNMI.LSP

Untested I remember Lee Mac saying it was important to release the html obj as it could cause a memory leak or something. ;;----------------------------------------------------------------------------;; ;; Copy Selected Xref Path to Clipboard with prompt. ;; https://www.cadtutor.net/forum/topic/98871-xref-path-copy-to-clipboard (defun c:XrefToClipBoard (/ SS Blk Path html) (vl-load-com) (if (setq SS (ssget "_+.:E:S" '((0 . "INSERT")))) (progn (setq blk (vla-get-effectivename (vlax-ename->vla-object (ssname SS 0)))) (setq blk (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk)) (if (= (vla-get-isxref blk) :vlax-true) (progn (setq Path (vla-get-Path blk)) (vlax-invoke (vlax-get (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" Path) (vlax-release-object html) (alert (strcat "\nPath Sent to Clipboard\n Xref Path: " Path)) ) (princ "\nSelected Block isn't an Xref.") ) ) (princ "\nNothing Selected") ) (princ) ) -edit updated code.

Thank you all for the replies. Lee & Tsuky, Your code works perfectly for me. Steven P, thanks for explaining what was happening under the hood, made perfect sense. As always, I appreciate it greatly!!

A simple script made with notepad. Open dwg1.dxf qsave dwg1 close Open dwg2.dxf qsave dwg2 close Open dwg3.dxf qsave dwg3 close Open dwg3.dxf qsave dwg3 close The dwg1 would be like "C:\\mydxfiles\\project123\\dwg1" There are various ways to make a list of dwg names, how many are we talking about ?

Excellent and encourages me all the more to learn more than lean so much.. Found a solution as when using a text with a space in front, it's automatically ignored.. Just slip this in after the: v (vla-get-TextString o) v (vl-string-left-trim " " v) ;; https://www.cadtutor.net/forum/topic/26510-remove-the-space-from-a-text/page/4/#findComment-324578

Hola. Contesto desde el móvil y sin probarlo, pero si no me equivoco bastaría con introducir el guión modificando esta parte del código así: (command "_exportlayout" (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) "-" presentacion ) ;(getvar "ctab") ".dwg") @ivaj Ya nos dices si te va.

Not too hard to create, a real pain to maintain as it must be compiled every time Autodesk decides to break binary compatibility

Hi mhupp, Thank you for the response. the result says: ; error: ActiveX Server returned the error: unknown name: IsXRef

Your code modified (defun C:MTW ; = MText Width (/ ss wf n mt val_text start end) (if (and (setq ss (ssget "_:L" '((0 . "MTEXT")))) (setq wf (getreal "\nWidth Factor to apply: ")) ); and (repeat (setq n (sslength ss)); then (setq mt (ssname ss (setq n (1- n)))) (setq val_text (getpropertyvalue mt "Contents")) (cond ((vl-string-search "{" val_text) (cond ((vl-string-search "\\W" val_text) (setq start (vl-string-search "\\W" val_text) end (vl-string-search ";" val_text 1) ) (repeat (1+ (- end start)) (setq val_text (vl-string-subst "" (chr (vl-string-elt val_text start)) val_text start)) ) (setpropertyvalue mt "Contents" val_text) ) (T (setpropertyvalue mt "Contents" (strcat "{\\W" (rtos wf 2) ";" (vl-string-left-trim "{" val_text) ) ) ) ) ) (T (setpropertyvalue mt "Contents" (strcat "{\\W" (rtos wf 2) ";" (getpropertyvalue mt "Contents") "}") ); setpropertyvalue ) ) ); repeat ); if (princ) )

The code is adding a width string to the text. These characters are hidden but will show up if you click on the text and look at it in the properties menu, or via the LISP line: (assoc 1 (entget(car(entsel)))) In the code it adds {\\W'wf'; to the string where wf is the width factor Something like {\\W0.8;Here is a text string} If you run the code again, it will add another width factor to the text string... but won't remove the first, so you get something like this: {\\W0.5;{\\W0.8;Here is a text string}} - noting that the new text width is applied and then the first one is applied.. result is you only see what was applied first. Need to remove this formatting to the text string before applying a new one. You might also have issues if other text formatting is used, such as underlined, italics, bold... For width you might be able to amend Lee Macs Unformat LISP to just unformat the width portion: https://lee-mac.com/unformatstring.html In these text strings replace with just 'W' ACcFfHLlOopQTW and here ACcFfHLlOoPpQSTW change to SW ... and then apply the new width formatting from your LISP .. though CAD is off so not tested - all part of the fun for you! ...if Lee Mac is passing through, feel free to correct me, though many years later I am just about understanding some of your codes.

IIRC, those are tough to manage on GIS programs with Add-ons made with Python, .NET, etc. Remember, real rivers/roads/ROWs have curves and organic shapes, not just straight lines. I did see some information on how to tackle those, hopefully it can be worked out, but don't expect perfection. As I mentioned, from what my daughter said and what I've seen in various related forums, the GIS pros are using whatever program and add-ons they can to get the bulk of it and cleaning up and filling in manually. Most that are doing those shapes want the main channel center, if needed I would ignore the very wide sections and side pieces and get those as center lines running back to the main channel separately. As your example shows, it would take separate polylines, so it will need to account for those sections and then ran again on the offshoots. You still haven't answered all of the questions asked. What type of work are you doing? What you have posted looks to be Civil and/or GIS work. I'll try some more on this when I can, I have also looked at some different shortest path codes, the last example is way over my head in LISP, I'll concentrate on the previous examples then try to run just the main channel on the last example .dwg. I have a full slate at work again today, but I'll try to jump back on this when I get some things out of the way. Home time is limited, but I'll try to get back on this with QGIS solution, I may see if my daughter's coworkers want to take a shot at these.

Hi @PGia, wow, you managed to find another example that fails. Good stress testing! The reason mine fails is because it ignores the offset lines that are split in two or more parts. But some of the parts are still be usable and should be used. I looked into fixing this and managed to add those lines, but this resulted in some other problems so I didn't update the code on the earlier post yet. The zigzag problem is coming back on your example. The result below. I really need to find a solution for that, but it looks like I might have to use a path finding algorithm which would slow down the code a lot. Sorting the points by distance on the offset line is not enough anymore.

Yes, but as it for as Title name for the topic. The plot is different. So, you're code will certenatly accomplish the desired result.

As @Clint ask for

Yes, this will substitued all layers into the UPPERCASE.

If I getted correct, this can be accomplish, but you need to do a systematization in naming the layers. One of the approaches can be to make an .txt file in which you will store the systematizated layers (the proper order must be, for e.g. "Tropic,Train,Traffic" or "Tropic\n" "Train\n" "Traffic\n" etc. The \n means new line). Then, you will run the code from my post, get an list of layers inside the drawing, then select desired layers to matches with .txt file from which you want to get a proper names (for e.g. in .txt file you have the layer name "TrAffiC", after choosing the layer "Traffic" in the drawing with "TrAffiC", you can substitued with proper name).

@Clint Please give it a try (defun c:lay-nam-to-capital (/ (ACAD-OBJ ADOC LAY-COLL)) (VL-LOAD-COM) (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) (SETQ LAY-COLL (VLA-GET-LAYERS ADOC)) (vlax-for lay lay-coll (vla-put-name lay (strcase (vla-get-name lay))) ) ;_ end of vlax-for ) ;_ end of defun

removed

Code posting guidelines When you are posting AutoLISP or VBA code in these forums, there are some simple guidelines you should observe in order to make life easier for you and for others. Always add routines or code snippets using the Code option. This makes them easier to read within posts by making them distinct from other text. It helps those who may want to copy and paste the code. It also helps to save space because code blocks get a scroll bar beyond a certain number of lines. 1. Click the Code button on the editor toolbar. That's the one with the "<>" on it. You will then see the Code modal, shown below. 2. Type or paste your code into the text box. 3. Select "No Syntax Highlighting" from the drop-down. 4. Click Insert into post. 5. Add any instructions or additional commentary to your post. 6. Click Submit Reply (or Submit Topic if you are starting a new topic). See the next post in this topic for the final result. Please ensure that you have the right to publish code on a public forum. In most cases, the code you are publishing will be your own and it will be assumed that if no attribution is given, you are the author. However, if you are not the author, you must make this clear and where possible, give credit to the author. Any routines published here must have their header intact, including any title, instructions, author contact details, date and copyright information. If at all possible, please make sure that you have the author's permission to publish their work. You may, at your discretion, claim specific copyright over your code. All authors have the right to explicitly claim copyright of their code. We recommend that if you wish to do so, you use a standard form such as Creative Commons.