Leaderboard

Nice test case @PGia, it did have some undesirable zigzags on those lines. I made some changes to the code to prevent this from happening. It should create a smooth line again!

@PGia Thanks for the encouragement and checking the results. I measure from the vertices instead of the lines. Those are calculated and the lines are just to connect the points. So perpendicular to the middle of segments of the centerline will always be a bit off, but if you measure from the vertices it should be centered correctly. Just like @GP_ said. I kept going in the same direction and I have made some improvements and got rid of some bugginess: The centerline should be a little more accurate now because of extra measurements (blue line) Crossing polylines get sharp corners on negative side Corner checks are done on all intersections of temporary line now (red line) More error checking so it doesn't crash on some of the example lines I left all of the 'animation' code commented out so you can give it a try ;| ; 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/6/#findComment-677339 ; Version 0.1 - Initial release 19-11-2025 ; Version 0.2 - Added corner support on negative side of crossing polylines 27-11-2025 ; Version 0.3 - Extra check using vertex to closest point as distance 28-11-2025 ; Version 0.4 - Added error function 28-11-2025 ; Version 0.5 - Improved distance check to prevent zigzag lines 01-12-2025 ; Version 0.6 - Check if offset can be used before adding points 01-12-2025 ; Version 0.7 - Improved side check on 3 points 01-12-2025 |; (defun c:cpl (/ corners ent1 ent2 enx2 flipped loop maxlen offset offsetdistance pts sides ss start te0 te1 te2 LM:ProjectPointToLine LM:intersections _addPoints _avarageAngle _checkOffset _cornerOffset _doOffset _getAnglesAtParam _getLength _polyline _rlw _side _wait *error*) (defun *error* (st) (if (wcmatch (strcase st t) "*break,*cancel*,*exit*") (redraw) (progn (vl-bt) (princ (strcat "\nOops! Something went wrong: ") st) ) ) (if (not (vlax-erased-p te0)) (entdel te0)) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) (princ) ) ;| ; 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 _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 _getLength (ent) (- (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) (vlax-curve-getDistAtParam ent (vlax-curve-getStartParam ent)) ) ) (defun _wait (msec) (not ( (lambda (start) (while (< (- (getvar 'millisecs) start) msec)) ) (getvar 'millisecs) ) ) ) (defun _addPoints (lst ent1 ent2 pts / len1 len2) (setq len1 (_getLength ent1) len2 (_getLength 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 (+ (/ d1 len1) (/ d2 len2)) pt) ) )) lst ) ) pts (append lst pts)) ; Animation ; (setq pts (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) ; (redraw) ; (foreach pt lst ; (tmpPoint (cadr pt) 1 1) ; ) ; ( ; (lambda (lst) ; (while (cadr lst) ; (grdraw (cadar lst) (cadar (setq lst (cdr lst))) 3) ; ) ; ) ; pts ; ) ; (vla-update ent1) ; (_wait 40) ; End animation pts ) (defun _checkOffset (ent1 ent2 offset) (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) ) ) (defun _doOffset (offset / lst rtn) ; Global vars: pts ent1 ent2 sides te1 te2 (setq te1 nil) (setq te2 nil) (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 (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if (car sides) offset (- offset)))))) (cdr te1) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if (cadr sides) offset (- offset)))))) (cdr te2) (not (_checkOffset ent1 (car te1) offset)) (not (_checkOffset ent2 (car te2) offset)) (vla-put-visible (car te1) :vlax-false) (vla-put-visible (car te2) :vlax-false) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq pts (_addPoints lst (car te1) (car te2) pts)) lst ) ) ) (if (and te1 (not (vl-catch-all-error-p te1))) (mapcar 'vla-delete te1)) (if (and te2 (not (vl-catch-all-error-p te2))) (mapcar 'vla-delete te2)) rtn ) ;| ; 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) (if (< (rem (+ ang1 pi) (+ pi pi)) (rem (+ ang2 pi) (+ pi pi)) ) (+ (* (- ang2 ang1) 0.5) ang1) (+ (* (- ang1 ang2) 0.5) ang2) ) ) ;| ; 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 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 ; Animation ; (progn ; (redraw) ; (grdraw pt1 pt2 1) ; (grdraw pt4 pt5 2) ; (grdraw pt1 pt5 2) ; (grdraw pt2 pt5 2) ; (vla-update ent1) ; (_wait 120) ; ) ; End Animation ) ) ) (if (not (vlax-erased-p te0)) (entdel te0)) (setq index (1+ index)) ) rtn ) (defun _rlw (lw / x1 x2 x3 x4 x5 x6) (if (and lw (= (cdr (assoc 0 lw)) "LWPOLYLINE")) (progn (foreach a1 lw (cond ((= (car a1) 10) (setq x2 (cons a1 x2))) ((= (car a1) 40) (setq x4 (cons (cons 41 (cdr a1)) x4))) ((= (car a1) 41) (setq x3 (cons (cons 40 (cdr a1)) x3))) ((= (car a1) 42) (setq x5 (cons (cons 42 (- (cdr a1))) x5))) ((= (car a1) 210) (setq x6 (cons a1 x6))) (t (setq x1 (cons a1 x1))) ) ) (append (reverse x1) (append (apply (function append) (apply (function mapcar) (cons 'list (list x2 (cdr (reverse (cons (car x3) (reverse x3)))) (cdr (reverse (cons (car x4) (reverse x4)))) (cdr (reverse (cons (car x5) (reverse x5)))) )) )) x6) ) ) ) ) (if (and (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq enx2 (entget ent2)) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) ent1 ent2 ) (progn (and (< (distance (vlax-curve-getStartPoint ent1) (vlax-curve-getEndPoint ent2)) (distance (vlax-curve-getEndPoint ent1) (vlax-curve-getEndPoint ent2)) ) (setq flipped t) (entmod (_rlw enx2)) ) (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) ) ) (if (not (numberp halfPi)) (setq halfPi (* pi 0.5))) (setq maxlen (* 1.1 (max (_getLength ent1) (_getLength ent2) ( (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.00) (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 ) ent1 ent2 ) ) ) ) (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)) ; Animation ; (redraw) ; (grdraw pt (vlax-curve-getClosestPointTo ent2 pt) 4) ; ( ; (lambda (mid) (grdraw mid (polar mid (+ (angle pt (vlax-curve-getClosestPointTo ent2 pt)) halfPi) (car corners)) 2)) ; (mapcar (function (lambda (a b) (* (+ a b) 0.5))) pt (vlax-curve-getClosestPointTo ent2 pt)) ; ) ; (vla-update ent1) ; (_wait 120) ; End animation ) )) (list ent1 ent2) (list ent2 ent1) ) (setq corners (vl-sort (append corners (_cornerOffset ent1 ent2) (_cornerOffset ent2 ent1)) '<) offsetdistance (/ maxlen 512.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) ) (while (progn (while (and corners (> offset (car corners))) ; Calculated offset values to check (_doOffset (car corners)) (setq corners (cdr corners)) ) (setq loop ; Incremental check (cond ((> offset maxlen) nil) ((_doOffset offset) (setq start t)) ((not start) t) (start nil) ) ) (setq offset (+ offset offsetdistance)) loop ) ) (if flipped (entmod enx2)) (if pts ; Draw polyline (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b)))))) (and (vlax-curve-isClosed ent1) (vlax-curve-isClosed ent2)) ) ) ) ) (redraw) (princ) ) And here is an animation of it working just because they are fun to look at :

I’ve always thought that a centerline should keep the same distance to the left and right, in the direction of travel. But from a geometric standpoint, maybe it should be as you say.I won’t get into that controversy. Perhaps that approach does make it possible to obtain the centerline in more situations. Regarding @SLW210’s suggestion that I upload a drawing to put the proposed Lisp codes to the test, I think the most appropriate example is the bank of a small river. I trimmed a section and ran the codes by @dexus, @Lee Mac, @SLW210, @mhupp, and @GP_ on it. The geometry of the riverbanks seems to be quite stressful for all the codes, although Dexus’s code only loses control in a couple of areas. I’m attaching the file with all of this for anyone who wants to take a look. AxisExple2.dwg

The concept is incorrect. To be equidistant, every point on the centerline must be the same distance (perpendicular) from the two margins.

Anyway, the result obtained by Dexus's code is one of the best (perhaps the best) I've found on the web. Thanks for that, Dexus

...Continue from previous post, experiment with imperial mod, quotient, division. ##********************************************************************************************** ## 45 UDF/ Excel name: impaMQD() - Similar Excel MOD() function with optional parmeters, ## return quotient or division [opt_1Quotient_or_2Division]. ## ## Note: This function uses todec() & toimpa() as sub-functions. ## ## Notes with optional parameters: ## ## [opt_1Quotient_or_2Division] = 1 , Similar Excel QUOTIENT() function - Returns the integer ## portion of a division ## [opt_1Quotient_or_2Division] = 2 , division calculation (varDividend/varDivisor) ## ## Optional parameters other than 1 & 2 will return error #N/A ## ## Rev. 1.0 - 9/2/2025 ##********************************************************************************************** =LAMBDA(varDividend,varDivisor,[opt_1Quotient_or_2Division], LET(optN,IF(ISOMITTED(opt_1Quotient_or_2Division),0, IF(AND(opt_1Quotient_or_2Division<=2,opt_1Quotient_or_2Division>0),opt_1Quotient_or_2Division,NA())), varD1,todec(varDividend), varD2,todec(varDivisor), answrM,varD1-(varD2*INT(varD1/varD2)), answrQ,ROUNDDOWN(varD1/varD2,0), answrD,varD1/varD2, SWITCH(TRUE, optN=0,IF(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),answrM,IF(OR(AND(ISTEXT(varDividend),ISTEXT(varDivisor)),ISNUMBER(varDivisor)),toimpa(answrM),"Error!")), optN=1,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrQ,IF(ISNUMBER(varDivisor),toimpa(answrQ),"Error!")), optN=2,IF(OR(AND(ISNUMBER(varDividend),ISNUMBER(varDivisor)),AND(ISTEXT(varDividend),ISTEXT(varDivisor))),answrD,IF(ISNUMBER(varDivisor),toimpa(answrD),"Error!")), NA() ) ) )

Or just call MULTIPLE before calling APV.

Always been a fan of CMS. I had meant to test out v14 back when it was released, I think I couldn’t find the SDK or something. Anyway, Let’s check it. Good looking interface, Ribbon, menu bar, and title bar. I don’t do drawings much, so I’m mainly going to test out the IRX API. I’ve opened a few good size drawings, it seems responsive, zooming and panning is plenty fast.

Thanks LRM i do admit the task has a lot of posts and probably skipped over the one about using TIN's.

@BIGAL that was the essence of my suggestion about 100 posts ago (October 22). The results rely to heavily on the relative distribution of vertices (quantity and spacing) between the two polylines.

This is totally cool! This is a custom entity github.com/CEXT-Dan/ArxTin I’m very surprised this event worked! And it’s fast! There were three missing functions acedGetCurrentSelectionSet – missing acdbSymUtil()->blockModelSpaceId(pDb) – returns null

This is a test with wxArx, github.com/CEXT-Dan/WxArx Has a great looking palette, wxDialogs work fine.

Let’s setup IRX and see how it compares to ARX I setup an ENV path IRX14 that points to the SDK. I didn’t see any documentation on how to setup a project from scratch. But there is a wizard for visual studio. I’ve had done this before, basically, I brute force it. There is documentation for .NET and ODA stuff.

3d looks pretty good, I think the nav tool is pretty cool as its activated on mouse over, though it’s hard to see with some visual styles

@SLW210 This weekend i finished a LISP that does exactly what i need, since there doesnt seem te be a regular AutoCAD-Map3D function for this. This code collects all object data on a layer, creates a 'exportprofile' for this specific layer and export this to its own SHP File. Since all EPF files are created for an individual layer, each SHP only gets the assigned ObjectData instead of 'All' objectdata in the DWG. code is based on the Dutch NLCS Cad standard for layer detection versus points/lines/polygons. ;;; ------------------------------------------------------------ ;;; MAPEXP_OD_ALL.LSP ;;; Export each layer to its own SHP using -MAPEXPORT + per-layer EPF ;;; - One SHP per layer in a subfolder: ;;; <DWGNAME>_YYYYMMDD_HHMMSS under the DWG folder ;;; - Uses DWGTITLED: if DWG not saved, alert & abort ;;; - Geometry type controlled by layer name suffix: ;;; * -S -> Point ;;; * -G -> Line ;;; * -GV -> Polygon ;;; Layers without those suffixes fall back to first-entity detection. ;;; - Per-layer Object Data (OD) mapped via ExpressionFieldMappings ;;; - EPF filters by that layer (DoFilterByLayer=1 + LayerList) ;;; - Treats closed polylines as polygons ;;; - Temp EPF is deleted after export ;;; - If SHP already exists: Overwrite via default ENTER, Load Profile? = Y ;;; - SHP filename: all '.' in the *layer name* are changed to ',' in the output file ;;; ------------------------------------------------------------ (vl-load-com) ;;; Global export folder (set in c:MAPEXP_OD_ALL) (setq *mapexp-export-folder* nil) ;;; --- small helpers --- (defun mapexp-get-dwg-folder ( / p ) ;; Use DWGPREFIX; ensure it ends with a backslash (setq p (getvar "DWGPREFIX")) (if (and p (/= p "") (/= (substr p (strlen p) 1) "\\")) (setq p (strcat p "\\")) ) p ) (defun mapexp-pad2 (n) ;; Pad single digit to 2 chars (e.g. 7 -> "07") (if (< n 10) (strcat "0" (itoa n)) (itoa n)) ) (defun mapexp-get-datetime ( / s lst ) ;; Get current date/time using EDTIME (compatible across versions) ;; Returns list: (year month day hour minute second) ;; %Y = year, %m = month, %d = day, %H = hour, %M = minute, %S = second ;; EDTIME format here: "YYYY MM DD HH MM SS" (setq s (menucmd "M=$(edtime,$(getvar,DATE),YYYY MM DD HH MM SS)")) ;; s is like "2025 11 21 14 32 05" ;; Turn it into "(2025 11 21 14 32 05)" and READ it (setq lst (read (strcat "(" s ")"))) lst ) (defun mapexp-get-export-folder ( / base path dt year mon day hh mm ss folder ) ;; Create export folder: ;; <DWGNAME_without_ext>_YYYYMMDD_HHMMSS ;; in the same folder as the DWG (setq path (getvar "DWGPREFIX")) (setq base (vl-filename-base (getvar "DWGNAME"))) ;; Use EDTIME-based datetime function (setq dt (mapexp-get-datetime)) (setq year (itoa (nth 0 dt))) (setq mon (mapexp-pad2 (nth 1 dt))) (setq day (mapexp-pad2 (nth 2 dt))) (setq hh (mapexp-pad2 (nth 3 dt))) (setq mm (mapexp-pad2 (nth 4 dt))) (setq ss (mapexp-pad2 (nth 5 dt))) (setq folder (strcat path "SHP_OD_EXPORT_" base "_" year mon day "_" hh mm ss "\\") ) ;; Create folder if it doesn't exist yet (if (not (vl-file-directory-p folder)) (vl-mkdir folder) ) folder ) (defun mapexp-sanitize-filename ( name / bad i ch ) ;; Replace characters that are invalid in file names (setq bad (list 34 42 47 58 60 62 63 92 124)) ; " * / : < > ? \ | (setq i 0) (while (< i (strlen name)) (setq ch (ascii (substr name (1+ i) 1))) (if (member ch bad) (setq name (strcat (substr name 1 i) "_" (substr name (+ i 2)) ) ) (setq i (1+ i)) ) ) name ) ;;; For the OUTPUT FILE NAME ONLY: ;;; - change '.' to ',' in the layer name ;;; - then sanitize for filesystem (quotes, *, /, :, <, >, ?, \, |) (defun mapexp-make-output-name (lay / s) (setq s lay) ;; Replace all dots with commas (setq s (vl-string-subst "," "." s)) ;; Remove OS-invalid characters but keep spaces, dashes, commas, etc. (setq s (mapexp-sanitize-filename s)) s ) (defun mapexp-first-entity-on-layer ( lay / ss ent ) (setq ss (ssget "X" (list (cons 8 lay)))) (if (and ss (> (sslength ss) 0)) (ssname ss 0) nil ) ) ;;; Fallback geometry detection – if no suffix rule hit (defun mapexp-geometry-type-from-entity ( ent / ed typ flags ) ;; Returns one of "Point" "Line" "Polygon" or nil (setq ed (entget ent)) (setq typ (cdr (assoc 0 ed))) (cond ((member typ '("POINT" "MULTILEADER" "INSERT")) "Point") ((member typ '("LINE" "ARC" "CIRCLE")) "Line") ((member typ '("LWPOLYLINE" "POLYLINE")) (setq flags (cdr (assoc 70 ed))) (if (and flags (= (logand flags 1) 1)) "Polygon" "Line" ) ) ((member typ '("SPLINE")) "Line") ((member typ '("HATCH" "POLYGON")) "Polygon") (T nil) ) ) ;;; Geometry type forced by layer name suffix (defun mapexp-geomtype-from-layername ( lay / ) ;; rules: ;; * -GV -> Polygon ;; * -S -> Point ;; * -G -> Line (cond ((wcmatch lay "*-GV") "Polygon") ((wcmatch lay "*-S") "Point") ((wcmatch lay "*-G") "Line") (T nil) ) ) ;;; Sanitize a string to be a valid FDO property name: ;;; - Only A–Z, a–z, 0–9, _ ;;; - If first char is not a letter or _, prefix with "F_" (defun mapexp-sanitize-fdo-name (s / i ch result) (if (not s) (setq s "FDO_NAME")) (setq result "") (setq i 1) (while (<= i (strlen s)) (setq ch (substr s i 1)) (if (wcmatch ch "[A-Za-z0-9_]") (setq result (strcat result ch)) (setq result (strcat result "_")) ) (setq i (1+ i)) ) ;; make sure first char is letter or _ (if (or (= result "") (not (wcmatch (substr result 1 1) "[A-Za-z_]")) ) (setq result (strcat "F_" result)) ) result ) ;;; Get unique OD table names used on a given layer (defun mapexp-get-od-tables-on-layer (layname / ss i e odtabs tbls tabName) (setq tbls '()) (setq ss (ssget "X" (list (cons 8 layname)))) ; all ents on layer (if ss (progn (setq i 0) (while (< i (sslength ss)) (setq e (ssname ss i) odtabs (ade_odgettables e) ; Map 3D ADE function ) (foreach tabName odtabs (if (and tabName (not (member tabName tbls))) (setq tbls (cons tabName tbls)) ) ) (setq i (1+ i)) ) ) ) (reverse tbls) ) ;;; --- EPF writer: SHP + OD + layer filter --- (defun mapexp-write-epf-with-od ( epfpath geomType layName odTabs / file tabName def_tbl cols col colName colType dataType usedNames outName baseName idx ) ;; geomType must be "Point" "Line" or "Polygon" (setq file (open epfpath "W")) (if (null file) nil (progn ;; Header – based on working AdMapExportProfile structure for SHP (princ "<AdMapExportProfile version=\"2.1.3\">" file) (princ "<LoadedProfileName/>" file) (princ "<StorageOptions>" file) (princ "<StorageType>FileOneEntityType</StorageType>" file) (princ "<GeometryType>" file) (princ geomType file) (princ "</GeometryType><FilePrefix/></StorageOptions>" file) ;; Auto-selection; filter by layer below (princ "<SelectionOptions><UseSelectionSet>0</UseSelectionSet><UseAutoSelection>1</UseAutoSelection></SelectionOptions>" file) (princ "<TranslationOptions>" file) ;; treat closed polylines as polygons (princ "<TreatClosedPolylinesAsPolygons>1</TreatClosedPolylinesAsPolygons>" file) (princ "<ExplodeBlocks>1</ExplodeBlocks>" file) (princ "<LayersToLevels><MapLayersToLevels>0</MapLayersToLevels><LayerToLevelMapping/></LayersToLevels>" file) (princ "</TranslationOptions>" file) (princ "<TopologyOptions><GroupComplexPolygons>0</GroupComplexPolygons><TopologyName/></TopologyOptions>" file) ;; Filter by this layer only (princ "<LayerOptions>" file) (princ "<DoFilterByLayer>1</DoFilterByLayer>" file) (princ "<LayerList>" file) (princ layName file) (princ "</LayerList>" file) (princ "</LayerOptions>" file) (princ "<FeatureClassOptions><DoFilterByFeatureClass>0</DoFilterByFeatureClass><FeatureClassList/></FeatureClassOptions>" file) ;; TableDataType "None" – OD via ExpressionFieldMappings (princ "<TableDataOptions>" file) (princ "<TableDataType>None</TableDataType>" file) (princ "<Name/>" file) (princ "<SQLKeyOnly>0</SQLKeyOnly>" file) (princ "</TableDataOptions>" file) (princ "<CoordSysOptions><DoCoordinateConversion>0</DoCoordinateConversion><CoordSysName/></CoordSysOptions>" file) ;; SHP target (princ "<TargetNameOptions><FormatName>SHP</FormatName></TargetNameOptions>" file) (princ "<DriverOptions/>" file) (princ "<UseUniqueKeyField>0</UseUniqueKeyField><UseUniqueKeyFieldName>AdMapKey</UseUniqueKeyFieldName>" file) ;; ===== OD ExpressionFieldMappings ===== (princ "<ExpressionFieldMappings>" file) (setq usedNames '()) ; track used attribute names to avoid duplicates (foreach tabName odTabs (setq def_tbl (ade_odtabledefn tabName)) ;; ADE table definition ;; def_tbl: (("TableName" . "...") ("Description" . "...") ("Columns" . ( ... ))) (setq cols (cdr (assoc "Columns" def_tbl))) (foreach col cols (setq colName (cdr (assoc "ColName" col))) (setq colType (cdr (assoc "ColType" col))) (if colName (progn ;; Map OD type to EPF Datatype (setq dataType (cond ((and colType (wcmatch (strcase colType) "*INT*")) "IntegerDataType" ) ((and colType (wcmatch (strcase colType) "*REAL*,*DOUBLE*,*FLOAT*,*NUM*")) "DoubleDataType" ) (T "CharacterDataType") ) ) ;; Decide attribute (FDO property) name: ;; - sanitize to valid FDO name ;; - if duplicate, append 2,3,... (setq baseName (mapexp-sanitize-fdo-name colName)) (setq outName baseName idx 1 ) (while (member (strcase outName) usedNames) (setq idx (1+ idx)) (setq outName (strcat baseName (itoa idx))) ) (setq usedNames (cons (strcase outName) usedNames)) ;; <NameValuePair> mapping: ;; <Name>outName</Name> -> FDO-safe property name ;; <Value>:ColName@Table</Value> -> actual OD mapping ;; <Datatype>...</Datatype> (princ "<NameValuePair><Name>" file) (princ outName file) (princ "</Name><Value>:" file) (princ colName file) (princ "@" file) (princ tabName file) (princ "</Value><Datatype>" file) (princ dataType file) (princ "</Datatype></NameValuePair>" file) ) ) ) ) (princ "</ExpressionFieldMappings>" file) (princ "</AdMapExportProfile>" file) (close file) T ) ) ) ;;; --- main export per layer --- (defun mapexp-export-layer-to-shp ( lay / ent geomType dwgFolder shpName shpFull epfFull odTabs ok ) ;; Prefer explicit geometry from layer name; fall back to entity if not matched (setq geomType (mapexp-geomtype-from-layername lay)) (if (null geomType) (progn (setq ent (mapexp-first-entity-on-layer lay)) (if (null ent) (setq geomType nil) (setq geomType (mapexp-geometry-type-from-entity ent)) ) ) ) (if (null geomType) nil (progn ;; Use the global export folder instead of the DWG folder (setq dwgFolder *mapexp-export-folder*) ;; SHP base name: layer name, but '.' -> ',' and OS-invalid chars cleaned (setq shpName (mapexp-make-output-name lay)) (setq shpFull (strcat dwgFolder shpName ".shp")) (setq epfFull (strcat dwgFolder shpName "_temp_export.epf")) ;; OD tables used on this layer (setq odTabs (mapexp-get-od-tables-on-layer lay)) ;; EPF for this geometry type + layer OD + layer filter (setq ok (mapexp-write-epf-with-od epfFull geomType lay odTabs)) (if ok (progn ;; If SHP already exists, we expect Overwrite prompt: ;; This file already exists. Enter an option [Overwrite/Cancel] <Overwrite>: ;; -> we send "" (ENTER) to accept default Overwrite ;; Then: Load Profile? [Yes/No] <No>: -> we send "Y" (princ "\n") (if (findfile shpFull) (command "-MAPEXPORT" "SHP" shpFull "" ; Overwrite? -> ENTER = default Overwrite "Y" ; Load Profile? Yes epfFull "Proceed" ) (command "-MAPEXPORT" "SHP" shpFull "Y" ; Load Profile? Yes (no overwrite prompt) epfFull "Proceed" ) ) ;; Delete temp EPF (if (findfile epfFull) (vl-file-delete epfFull) ) T ) nil ) ) ) ) ;;; --- public command --- (defun c:MAPEXP_OD_ALL ( / lay rec ) (vl-load-com) ;; Check if drawing is saved (if (= (getvar "DWGTITLED") 0) (progn (alert "Deze tekening is nog niet opgeslagen.\n\nSla de DWG eerst op en start MAPEXP_OD_ALL daarna opnieuw." ) (princ) ) (progn (setvar "CMDECHO" 0) ;; Create export folder for this run (setq *mapexp-export-folder* (mapexp-get-export-folder)) (prompt (strcat "\nMAPEXP_OD_ALL – exportfolder: " *mapexp-export-folder* ) ) ;; loop through all layers in the table (setq rec (tblnext "LAYER" T)) (while rec (setq lay (cdr (assoc 2 rec))) ; layer name ;; skip xref layers (contain "|") (if (not (wcmatch lay "*|*")) (mapexp-export-layer-to-shp lay) ) (setq rec (tblnext "LAYER")) ) (setvar "CMDECHO" 1) (prompt "\nMAPEXP_OD_ALL – done.") (princ) ) ) )

Rather than explode the COGO point what are you trying to do ? I have for example write the RL of a cogo point as text next to the point. We used this as a quick reference when designing, we would select only the points that we want to see the RL. It could be expanded to say label XYZ, PtXYZD etc. The tree block should be on the correct layer according to your Description key Sets. A side note it's possible to update a cogo point dynamic block, I have something that does just that, it looks at the description, so TR6*300, dynamic block has a trunk and spread 2 objects, running my lisp would get a 6m spread with a 300 mm trunk. @Steven P the COGO points in Civ3D are proxy objects. In a dwg if labels are off can not turn on in ACAD. I am looking at talking to Bricsys about getting at "AeccXUiLand.AeccApplication." when a civ3D dwg is opened in Bricscad. Getting at CIV3D objects via lisp can be easy or difficult.

Up load your LISP so we can have a look. I suspect you will want to explode the block and then use entlast select it ready to move it to the correct layer - that might be enough of a hint? Since you have the entity name, I would just use entmod to change the layer

Glad it works. Yes.

Hi thanks a lot. It works. how can i call multiple prior to calling APV? A friend of mine got me this vlx file but there is an annoying pop-up but it works as well addv.vlx

Since Lee's Code only has you picking a point its easy enough. Just add a call at the end of APV (line 95) to call itself again. This will force a loop that you have to hit esc to exit. - Edit This is a better option. Has undo marks. You could also set your snaps before entering the command if you want to. ;;----------------------------------------------------------------------------;; ;; Add Polyline Vertex loop ;; Dependent AddLWPolylineVertexV1-1.lsp (defun C:APVL ( / ) (vl-load-com) (princ "\nStarting Add Polyline Vertex loop. Press ESC to stop.") (vla-StartUndoMark (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))) ;(setvar 'OSMODE 3) ;End and mid point snaps (while T (C:APV) ) (princ "\nAdd Polyline Vertex Loop ended.") (vla-EndUndoMark doc) (princ) )

You're missing the double backslash ("*\\P*") Also, note that the use of vl-string-subst with a constant starting position and wcmatch to test the content is dangerous in general as this will result in an infinite loop if the replacement string contains the find string, e.g. consider replacing "new" with "knew" - your code would loop indefinitely.

In the voronoi version some error checking before trying to call _polyline should be added indeed. And this function is dependent on how well the points are distributed over the line (ent->pts function). For the lines close together, more points should be given and with crossing lines it will not work at all. It only works if the lines stay in between the two polylines, and it doesn't in the example from OP:

Thanks. The animation in the GIF is from the calculations made in _cornerOffset. When it was (finally ) working I replaced the animation code with error checking. Didn't take the time to make it do both, but I did want to show how it worked here.

Try this. Note only do one direction at a time do lefts exit and repeat to do rights. ; https://www.cadtutor.net/forum/topic/98817-create-polyline-automatically/ ; Custom draw pline by Alan H Nov 2025 Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; By Alan H July 2020 ; (defun c:wow ( / co-ord ht pt0 pt1 pty1a pt2 pt2a ht oldsnap) (defun c:wow ( / ) (defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint) (setq obj (vlax-ename->vla-object ent)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (command "Pedit" ent "R" "") ) (princ) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq pt1 (getpoint "\nPick 1st point ")) (setvar 'osmode 128) (setq pt2 (getpoint pt1 "\nPick 2nd point on object ")) (setvar 'osmode 0) (setq pt0 (polar pt1 (/ pi 2.0) 4.0)) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3 (polar pt2a pi 3.7)) (setq pt4 (polar pt3 (/ pi 2.0) 2.2)) "C" ) (setq ent (car (entsel "\Pick End Rectangle "))) (AH:chkcwccw ent) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq mp (mapcar '* (mapcar '+ (nth 1 co-ord) (nth 2 co-ord)) '(0.5 0.5))) (setq pt4 (polar mp (* 1.5 pi) (* 0.4 (distance (nth 0 co-ord) (nth 1 co-ord))))) (setq pt5 (mapcar '* (mapcar '+ (nth 0 co-ord) (nth 3 co-ord)) '(0.5 0.5))) (setq pt3 (list (car pt2) (cadr pt4))) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") (while (setq pt6 (getpoint "\nPick 1st point Enter to exit ")) (setq ang (angle pt2 pt6)) (if (and (>= ang (/ pi 2.0))(<= ang (* 1.5 pi))) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (- (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (- (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (- (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (- (car pt5) 0.1)(cadr pt5))) ) (progn (setq pt0 (list (car pt6)(- (cadr pt0) 0.1))) (setq pt1 (list (car pt6)(- (cadr pt1) 0.1))) (setq pt2 (list (+ (car pt2) 0.1)(- (cadr pt2) 0.1))) (setq pt3 (list (+ (car pt3) 0.1)(- (cadr pt3) 0.1))) (setq pt4 (list (+ (car pt4) 0.1)(- (cadr pt4) 0.1))) (setq pt5 (list (+ (car pt5) 0.1)(cadr pt5))) ) ) (command "pline" (setq pt1a (polar pt0 0.0 1.85)) (setq pt2a (polar pt1a (* 1.5 pi) 2.2)) (setq pt3a (polar pt2a pi 3.7)) (polar pt3a (/ pi 2.0) 2.2) "C" ) (command "pline" pt0 pt1 pt2 pt3 pt4 pt5 "") ) (setvar 'osmode oldsnap) (princ) ) (C:wow)

I recently received an email from someone asking me to take a look at this thread and see if I had a possible solution for his company. I have never used DwgProps, but with the help of some very useful posts on the forums by Gilles Chanteau, I was able to create NewProps.lsp to extract information from an Excel file and put it in DwgProps. I would recommend testing it in a new drawing first. Download and copy NewProps.lsp to a folder in your AutoCAD Search Path. You can download the latest version of GetExcel.lsp from https://autolisp-exchange.com/AutoLISP-Code.htm . Download the images and spreadsheet here to look at and test. Load NewProps.lsp and GetExcel.lsp and type NewProps on the command line to run it. Best of luck. Terry NewProps.lsp NA-09317-PB.xlsx

There are numerous chainage lisps out there they all use the getpointatdist or the opposite the getdistatpoint VL functions, so you can pick a point on a pline and get its distance back to start point. You could also do add a chainage where the start point is not 0.0 The problem was with your dwg the white broken lines were not a continuous pline. You also need to look at how to apply what is the start chainage so it can be added to the distance retrieved. Is the chainages of known points always there as can do a read text get chainage and what the start chainage is ? Hence delay in posting code. They are mtext as well so a bit more to strip out the values. I have allowed for "Ch 5000.5" etc. It is expected that as the chainages are labelled the pline has a correct start point. Follow the prompts pick pline, pick existing chainage text pick corresponding chainage point, then pick points, press Enter to exit. I will leave it to you make sure text style and side is correct. ; label chainage points ; big thanks to lee-mac for sub routines. ; By alan H Oct 2020 ;;-------------------=={ Parse Numbers }==--------------------;;` ;; ;; ;; Parses a list of numerical values from a supplied string. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; s - String to process ;; ;;------------------------------------------------------------;; ;; Returns: List of numerical values found in string. ;; ;;------------------------------------------------------------;; (defun LM:ParseNumbers ( s ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar (function (lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) ) (cons nil l) l (append (cdr l) (list nil)) ) ) ")" ) ) ) (vl-string->list s) ) ) ;;-------------------=={ UnFormat String }==------------------;; ;; ;; ;; Returns a string with all MText formatting codes removed. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; str - String to Process ;; ;; mtx - MText Flag (T if string is for use in MText) ;; ;;------------------------------------------------------------;; ;; Returns: String with formatting codes removed ;; ;;------------------------------------------------------------;; (defun LM:UnFormat ( str mtx / _replace rx ) (defun _replace ( new old str ) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new) ) (if (setq rx (vlax-get-or-create-object "VBScript.RegExp")) (progn (setq str (vl-catch-all-apply (function (lambda ( ) (vlax-put-property rx 'global actrue) (vlax-put-property rx 'multiline actrue) (vlax-put-property rx 'ignorecase acfalse) (foreach pair '( ("\032" . "\\\\\\\\") (" " . "\\\\P|\\n|\\t") ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]") ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);") ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}") ("$1" . "[\\\\]({)|{") ) (setq str (_replace (car pair) (cdr pair) str)) ) (if mtx (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)) (_replace "\\" "\032" str) ) ) ) ) ) (vlax-release-object rx) (if (null (vl-catch-all-error-p str)) str ) ) ) ) (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt ) ) ) ) ;; Make Readable - Lee Mac ;; Returns a given angle corrected for text readability (defun lm:makereadable (a) ((lambda (a) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (+ a pi) a ) ) (rem (+ a pi pi) (+ pi pi)) ) ) (defun c:test ( / pt oldsnap obj obj2 ch stch dist ang) (setq oldsnap (getvar 'osmode) oldaunits (getvar 'aunits)) (setvar 'aunits 3) (setq obj2 (vlax-ename->vla-object (car (entsel "\nPick Pline ")))) (setq obj (vlax-ename->vla-object (car (entsel "\nPick Chainage text ")))) (setq ch (nth 0 (LM:ParseNumbers (LM:UnFormat (vla-get-textstring obj) nil) ))) (setq pt (getpoint "Pick text chainage point ")) (setq dist (vlax-curve-getdistatpoint obj2 pt)) (setq stch (- ch dist)) (while (setq pt (getpoint "\pick point on pline for new chainage")) (setvar 'osmode 0) (setq ang (- (alg-ang obj2 pt) (/ pi 2.0))) (setq ang (lm:makereadable ang)) (command "text" pt 1.25 ang (rtos (+ stch (vlax-curve-getdistatpoint obj2 pt)) 2 2)) (setvar 'osmode oldsnap) (setvar 'aunits oldaunits) ) (princ) ) (c:test)

Commands use UCS points - you are translating the UCS origin to WCS; use (trans '(0.0 0.0 0.0) 0 1) Alternatively: (defun cs2 nil (entmake (list '(0 . "LINE") '(10 0.0 0.0 0.0) ;; WCS origin (cons 11 (trans '(0.0 0.0 0.0) 1 0)) ;; UCS origin ) ) )