Leaderboard

I made some changes so it also works when the starting lines are intersecting. Cool to see lots of people try to solve this problem! Mine doesn't work well with parallel lines and doesn't generate arcs. It still looks like GP_'s solution has the best result for me, but for intersecting lines I have to execute the function twice and select the lines in two directions to get the full result. centerline.lsp

With my code it wouldn't matter because they would reorder on how they fall on the temp polyline unless one poly line is really squiggly (technical term)

See if this works will tweek it tonight if something throws error. Modified version of my last code Ask user to select first and 2nd polyline Find mid points from each vertex of poly1 to poly 2 with vlax-curve-getClosestPointTo Adds those points to a dotted pair with the vertex number Creates a temp polyine with those points Find minpoints from each vertex of poly2 to poly one with vlax-curve-getClosestPointTo Processed the 2nd list of points using vlax-curve-getClosestPointTo to temp polyline Using that with vlax-curve-getParamatpoint will tell where on the tempoly if falls Sort polylist by the parma so they will be in order and removing the parama so only point data is left Delete temp polyline Create new mid polyline with all points in right order. Stuff that is doing the heavy lifting is vlax-curve-getClosestPoint and vlax-curve-getParamatpoint. this will work with polylines with arc's but will only generate a mid polyline using straight lines. Everything you post they don't seem to have any arcs so you should be good. ;;----------------------------------------------------------------------------;; ;; POLY AVERAGE path between polylines, Finds the mid path (defun c:PA () (C:POLYAVG)) (defun c:POLYAVG (/ ent1 ent2 i tol ptv ptc par mid pts1 pts2 polylst tempoly) (setq ent1 (car (entsel "\nSelect first polyline: "))) (if (not (and ent1 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE"))) (progn (princ "\nInvalid 1st selection.") (exit) ) (setq ent1 (vlax-ename->vla-object ent1)) ) (setq ent2 (car (entsel "\nSelect 2nd polyline: "))) (if (not (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE"))) (progn (princ "\nInvalid first selection.") (exit) ) (setq ent2 (vlax-ename->vla-object ent2)) ) (if (and ent1 ent2) (progn (setq pts1 '()) (setq i 0) (setq tol (fix (vlax-curve-getEndParam ent1))) (while (<= i tol) (setq ptv (vlax-curve-getPointAtParam ent1 i)) (setq ptc (vlax-curve-getClosestPointTo ent2 ptv)) ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc))) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts1 (append pts1 (list mid))) (setq polylst (cons (cons mid i) polylst)) (setq i (1+ i)) ) (setq Flag (if (= (vla-get-Closed ent1) :vlax-true) 1 0)) ; Get closed status (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts1)) (cons 70 flag) ) (mapcar '(lambda (p) (cons 10 p)) pts1) ) ) (setq tempoly (entlast)) (setq pts2 '()) (setq i 0) (setq tol (fix (vlax-curve-getEndParam ent2))) (while (<= i tol) (setq ptv (vlax-curve-getPointAtParam ent2 i)) (setq ptc (vlax-curve-getClosestPointTo ent1 ptv)) ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc))) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts2 (append pts2 (list mid))) (setq i (1+ i)) ) (foreach pt pts2 (setq ptv (vlax-curve-getClosestPointTo tempoly pt)) (setq Par (vlax-curve-getParamatpoint tempoly ptv)) (setq polylst (cons (cons pt par) polylst)) ) (setq polylst (mapcar 'car (vl-sort polylst '(lambda (a b) (< (cdr a) (cdr b)))))) (entdel tempoly) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length polylst)) (cons 70 flag) ) (mapcar '(lambda (p) (cons 10 p)) polylst) ) ) (princ "\nNew midpoint polyline created.") ) (princ "\nSelection error.") ) (princ) ) -Edit Still a little janky but you can see why if you un-comment the entmake lines

In the DWG files you posted, I can't find the polylines indicated in the images. I don't think that result was obtained with CPL. I'd like to run a test, so please attach the DWG file with the reference position in the images. Thanks

As for the code from my first attempt, I suppose the least I should do for any “child of mine” is to make sure it can have a functional life, no matter how cross-eyed it was born: you never abandon a child. So here I leave a new version of “GLAVCVS’ cross-eyed child”, fresh out of the hospital. ;| G L A V C V S C R O S S - E Y E D C H I L D - o - ************************* G L A V C V S ************************* *************************** F E C I T ***************************|; (defun c:creAxis (/ e e1 e2 l i? l1 l2 lr p p0 p1 p2 px pm abis lii pmi pmf pi1 pi2 pf1 pf2 pc1 pc2 li1 o dameInters+Prox ordena decide sustituye damePuntos) (defun dameInters+Prox (p0 a lp / p1 px pt1 pt2 dmin d pf) (setq pt1 (polar p0 a 1e8) pt2 (polar p0 (+ a PI) 1e8)) (foreach p lp (if p1 (if (setq px (inters pt1 pt2 p1 p)) (if dmin (if (< (setq d (distance px p0)) dmin) (setq dmin d pf px)) (setq dmin (distance px p0) pf px)) ) ) (setq p1 p) ) pf ) (defun ordena (po px pm / p0 lr) (foreach p lii (if (and p0 (inters po px p0 p)) (setq lr (append lr (list pm))) ) (setq p0 p lr (append lr (list p))) ) ) (if (and (setq e1 (car (entsel "\nSelect FIRST LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l1 (entget e1)))) "LWPOLYLINE") (not (redraw e1 3))) (if (and (setq e2 (car (entsel "\nSelect SECOND LWPOLYLINE..."))) (= (cdr (assoc 0 (setq l2 (entget e2)))) "LWPOLYLINE") (not (redraw e2 3))) (progn (setq lp1 (reverse (foreach l l1 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil lp2 (reverse (foreach l l2 (if (= (car l) 10) (setq lr (cons (cdr l) lr)) lr))) lr nil ) (cond ((= (rem (cdr (assoc 70 l1)) 2) 1) (setq lp1 (append lp1 (list (car lp1) (cadr lp1) (caddr lp1)))) ) ((equal (car lp1) (last lp1)) (setq lp1 (append lp1 (list (cadr lp1) (caddr lp1)))) ) (T (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car lp1) (setq pc1 (vlax-curve-getClosestPointTo e2 (car lp1)))) pmf (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (last lp1) (setq pc2 (vlax-curve-getClosestPointTo e2 (last lp1)))) ) ) ) (cond ((= (rem (cdr (assoc 70 l2)) 2) 1) (if pmi (progn (foreach p (append lp2 (list (car lp2))) (if (or (equal p pmi 1e-4) (equal p pmf 1e-4)) (setq l (if l (not (setq lr (append l (list p)))) (list (list p)))) (if l (setq l (append l (list p)))) ) ) (setq lp2 lr lr nil l nil) ) (setq lp2 (append lp2 (list (car lp2) (cadr lp2)))) ) ) ((equal (car lp2) (last lp2)) (if pc1 (progn (foreach p lp2 (if (or (equal p pc1 1e-4) (equal p pc2 1e-4)) (setq l (if l (not (setq lr (append l (list p)))) (list (list p)))) (if l (setq l (append l (list p)))) ) ) (setq lp2 lr lr nil l nil) ) (setq lp2 (append lp2 (list (cadr lp2)))) ) ) ) (redraw e1 4) (redraw e2 4) (foreach lp (list lp1 lp2) (foreach l lp (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 l)) 2) (/ PI 2.)) px (dameInters+Prox p2 abis (if o lp1 lp2)) lr nil pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px)) lii (if o (if pm (ordena p2 px pm) lii) (if px (append lii (list pm)) lii)) p1 p2 p2 l ) (setq p2 l) ) (setq p1 l) ) ) (if pmi (setq lii (append (list pmi) lii (list pmf)))) (setq p1 nil p2 nil lr nil o T) ) ) ) ) (entmake (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (70 . 0) (60 . 0)) (list (cons 90 (length lii))) (mapcar '(lambda (a) (cons 10 a)) lii))) (princ) )

[code edited 11/3/2025] I have enjoyed the discussion of this thread. As I gave the task more thought and anaysis it became more clear that the task was not simple. As it appears that there is still no satisfacory solution I thought I would offer the following. The first goal for me was to create a function that would create a midline between two non parallel lines. The mid-lines extents should be a function of the given line segments. This function could then be used in a program that would step through the line segments of one of the polylines and search the other polyline for relevant segments. The function "midline" accepts four points. The first two points, A1 and A2, are the ends of one line sement while the thrid and fourth points, B1 and B2, are the ends of an opposing ilne segments. The diagram below details the variables in the function. The program uses vectors as I prefer them over angles which present, for me, a variety of problems. uA = unit vector in the diection from A1 to A2 uB = unit vector in the direction from B1 to B2 uBisector = unit vector in the direction of the angle bisector of uA and UB The ends of the two lines are projected onto the bisecting line defining 4 points, A1M, A2M, B1M, B2M. I debated which of the points to output for the line to be drawn. I first used the closest and furthest points from the intersecttion point ABIntr but I found it more helpful to use the two intermediate points (A1M and A2M in the example above). Here's an example of the results after manually steppng alone the polyline. Looking at the area circled in red we find: To fill the gap we need a curve that starts with a radius of 0.1514 and ends with a radius of 0.1693. This can be done with a spline or you may find it acceptable to extend the two lines to the point of intersection. The best way to create the spline is to use the Control Vertex Method and use the two endpoints and the imaginary point of intersecton for the middle CV. This ensures tangency to the two lines. As can be seen below the distance to a random point along the spline (red) agree! Run the program "test" and specify the end points of a line segment on one of the polylines, then the endpoints on a line segment on the opposing polyline. I have found the results very accurate and although it may not be used for creating the complete "hybrid " polyline it is helpful in finding the correct line for a specific segment. ;;---------------------------------------------------------------------------- ;; Determines the endpoints of a line the is midway between two lines defined by their end points. ; Input: 4 points, the ends of the first line followed by the ens of the second line ; Output: a list containing the two point of the midline if there's a solution and nil if no solution ; L. Minardi 10/31/2025 - Revised 11/3/2025 (defun midLine (a1 a2 b1 b2 / ua ub p vp d s a1m a2m b1m b2m d1 d2 d3 d4 slist a1p a2p b1p b2p m1 m2 mmid mp) (setq ua (unitVecAB a1 a2) ub (unitVecAB b1 b2) ) (if (< (dot ua ub) 0.0) (setq ub (mapcar '* ub '(-1 -1 -1))) ) (if (> (abs (dot ua ub)) 0.9999) ; are lines parallel? (progn ; lines are parallel (setq p (mapcar '/ (mapcar '+ a1 b1) '(2 2 2)) ; point on midline vp (list (- (cadr ua)) (car ua) 0.0) ; vector perpendicular to ua d (/ (dot (mapcar '- b1 a1) vp) 2.0) ; distance to midline s (dot (mapcar '- a1 p) ua) a1m (mapcar '+ p (mapcar '* ua (list s s s))) s (dot (mapcar '- a2 p) ua) a2m (mapcar '+ p (mapcar '* ua (list s s s))) s (dot (mapcar '- b1 p) ua) b1m (mapcar '+ p (mapcar '* ua (list s s s))) s (dot (mapcar '- b2 p) ua) b2m (mapcar '+ p (mapcar '* ua (list s s s))) d1 0.0 d2 (dot ua (mapcar '- a2m a1m)) d3 (dot ua (mapcar '- b1m a1m)) d4 (dot ua (mapcar '- b2m a1m)) ) (setq slist ; sorted list of distances (vl-sort (list (list a1m d1) (list a2m d2) (list b1m d3) (list b2m d4)) (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))) ; use the middle two mid point from the line (setq m1 (car (nth 1 slist)) m2 (car (nth 2 slist)) ) (setq mmid (mapcar '/ (mapcar '+ m1 m2) '(2 2 2))) (setq mp (* (dot (mapcar '- a1m mmid) (mapcar '- a2m mmid)))) (if (<= mp 0) (setq theLine (list m1 m2)) (setq theline nil) ) ;;;;; ) ) ; end lines parallel (progn ; lines are not parallel (setq ABIntr (inters A1 A2 B1 B2 nil)) (setq p (mapcar '+ ABIntr (mapcar '/ (mapcar '+ ua ub) '(2 2 2))) ;(setq p (mapcar '+ ABIntr (mapcar '/ (mapcar '+ a1 b1) '(2 2 2))) uBisector (unitVecAB ABIntr p) vp (list (- (cadr ua)) (car ua) 0.0) A1p (mapcar '+ A1 vp) a1m (inters A1 A1P ABIntr p nil) A2p (mapcar '+ A2 vp) a2m (inters A2 A2P ABIntr p nil) vp (list (- (cadr ub)) (car ub) 0.0) B1p (mapcar '+ B1 vp) B1m (inters B1 B1P ABIntr p nil) B2p (mapcar '+ B2 vp) B2m (inters B2 B2P ABIntr p nil) d1 (distance ABIntr a1m) d2 (distance ABIntr a2m) d3 (distance ABIntr b1m) d4 (distance ABIntr b2m) ) (setq slist (vl-sort (list (list a1m d1) (list a2m d2) (list b1m d3) (list b2m d4)) (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))) ) (setq m1 (car (nth 1 slist)) m2 (car (nth 2 slist)) ) (setq mmid (mapcar '/ (mapcar '+ m1 m2) '(2 2 2))) (setq mp (* (dot (mapcar '- a1m mmid) (mapcar '- a2m mmid)))) (if (<= mp 0) (setq theLine (list m1 m2)) (setq theline nil) ) ) ; end lines not parallel ) ; end if ) ; test function (defun c:test ( / a1 a2 b1 b2 mline ) (setq a1 (getpoint "\nEnter start point of first line: ") a2 (getpoint a1 "\nEnter end point of first line: ") b1 (getpoint "\nEnter start point of second line: ") b2 (getpoint b1 "\nEnter end point of second line: ") mline (midline a1 a2 b1 b2) ) (if mline (command "_line" "_non" (car mline) "_non" (cadr mline) "") (princ "\nNo Solution!") ) (princ) ) ; unit vector from point A to point B (defun unitVecAB (A B / x) (setq x (distance A B) x (mapcar '/ (mapcar '- B A) (list x x x)) ) ) ; dot product of vectors A and B (defun dot (A B / x) (setq x (mapcar '* A B)) (setq x (+ (nth 0 x) (nth 1 x) (nth 2 x))) );end of dot mid -poly.06.lsp

Coming back to this one: Annotative Text, I find that I have to create the text style and then add the extended data to convert it to annotative text Handy that this can have an if loop in it and be used to create either normal or annotative if you want to adjust it: (defun c:MakeAnnoFont ( FontName FontStyle / Height NewFontEnt exdata newent ) (setq Height 0) (setq NewFontEnt (entmakex (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") (cons 2 FontName) '(70 . 0) (cons 40 Height) '(41 . 1.0) '(50 . 0.0) '(71 . 0) (cons 42 Height) (cons 3 FontStyle) ;; Font style to include suffix e.g. '.ttf' or '.shx' '(4 . "") ))) ; end entmakex, end list, end setq ;;Add xdata - annotative text (regapp "AcadAnnotative") (setq exdata '((-3 ("AcadAnnotative" (1000 . "AnnotativeData") (1002 . "{") (1070 . 1) (1070 . 1) (1002 . "}") ) ; new extended data— )) ) (setq newent (append (entget NewFontEnt) exdata)) ; Appends new data list to entity's list. (entmod newent) ; Modifies the entity with the new definition data. (princ) ) I don't use a lot of annotative dimensions to make a LISP worthwhile, but reading this week I think the method is the same, create the dimension and then add the xdata to it afterwards. Most of my dimension LISPs started off from here: https://stackoverflow.com/questions/47835301/use-autolisp-to-generate-new-dimension-style Though from BigAl, I think this one sets all the dimension stuff ; https://www.cadtutor.net/forum/topic/56889-entmake-for-dimension-styles/ ; BigAl ; DimStyle Create ; (defun DSTYLE_DIMSTYLE_CREATE (DSTY$ DSCL# AH$ FSTY$) (if (null (tblsearch "dimstyle" DSTY$)) (progn (entmakex (list (cons 0 "DIMSTYLE") ; Entity Type (cons 100 "AcDbSymbolTableRecord") ; Subclass marker (cons 100 "AcDbDimStyleTableRecord") ; Subclass marker (cons 2 DSTY$) ; Dimstyle name (cons 70 0) ; Standard flag value (cons 3 "") ; DIMPOST (cons 4 "") ; DIMAPOST (cons 5 AH$) ; DIMBLK (cons 6 AH$) ; DIMBLK1 (cons 7 AH$) ; DIMBLK2 (cons 40 DSCL#) ; DIMSCALE (cons 41 0.0937) ; DIMASZ (cons 42 0.0937) ; DIMEXO (cons 43 0.38) ; DIMDLI (cons 44 0.0625) ; DIMEXE (cons 45 0.0) ; DIMRND (cons 46 0.0625) ; DIMDLE (cons 47 0.0) ; DIMTP (cons 48 0.0) ; DIMTM (cons 140 0.0937) ; DIMTXT (cons 141 0.09) ; DIMCEN (cons 142 0.0) ; DIMTSZ (cons 143 25.4) ; DIMALTF (cons 144 1.0) ; DIMLFAC (cons 145 0.0) ; DIMTVP (cons 146 1.0) ; DIMTFAC (cons 147 0.0625) ; DIMGAP (cons 71 0) ; DIMTOL (cons 72 0) ; DIMLIM (cons 73 0) ; DIMTIH (cons 74 0) ; DIMTOH (cons 75 0) ; DIMSE1 (cons 76 0) ; DIMSE2 (cons 77 0) ; DIMTAD (cons 78 3) ; DIMZIM (cons 170 0) ; DIMALT (cons 171 2) ; DIMALTD (cons 172 0) ; DIMTOFL (cons 173 0) ; DIMSAH (cons 174 0) ; DIMTIX (cons 175 0) ; DIMSOXD (cons 176 1) ; DIMCLRD (cons 177 1) ; DIMCLRE (cons 178 2) ; DIMCRRT (cons 270 4) ; DIMUNIT (cons 271 4) ; DIMDEC (cons 272 4) ; DIMTDEC (cons 273 2) ; DIMALTU (cons 274 2) ; DIMALTTD (cons 275 0) ; DIMAUNIT (cons 276 2) ; DIMFRAC (cons 277 4) ; DIMLUNIT (cons 279 2) ; DIMTMOVE (cons 280 0) ; DIMJUST (cons 281 0) ; DIMSD1 (cons 282 0) ; DIMSD2 (cons 283 1) ; DIMTOLJ (cons 284 0) ; DIMTZIN (cons 285 0) ; DIMALTZ (cons 286 0) ; DIMALTTZ (cons 287 5) ; DIMFIT (cons 288 0) ; DIMUPT (cons 340 (tblobjname "style" FSTY$)) ; DIMTXSTY (cons 342 (cdr (assoc 330 (entget (tblobjname "block" AH$))))); DIMLDRBLK (cons 343 (cdr (assoc 330 (entget (tblobjname "block" AH$))))); DIMLDRBLK1 (cons 344 (cdr (assoc 330 (entget (tblobjname "block" AH$))))); DIMLDRBLK2 ) ) ) ) And I'll give you 'Jeff' which has a better description of the one above Jeff just adjusts dimension font style, text height, and colours. Arrows are set at 2x font height I think - from the stackoverflow link above (defun c:jeff ( / DimStyleName DSN FontStyleName FSN FontHeight TxtCol LinCol Col TxtPrecision TxtPrec) ;;change dimension style ;;Dimension Style (princ "\nEnter Dimension style Name ")(princ (tableSearch "dimstyle")) (setq DimStyleName (getvar "dimstyle")) (setq DSN (getstring (strcat ": (" DimStyleName "): ") t)) (if (or (= DSN nil)(= DSN "")) (setq DimStyleName DimStyleName) (setq DimStyleName DSN) ) (princ DimStyleName) ;;Font Style (princ "\nEnter Font style Name ")(princ (tableSearch "style")) ;; (setq FontStyleName (nth 0 (tableSearch "style"))) (setq FontStyleName (getvar "textstyle")) (setq FSN (getstring (strcat " (" FontStyleName "): ") t)) (if (or (= FSN nil)(= FSN "")) (setq FontStyleName FontStyleName) (setq FontStyleName FSN) ) (princ FontStyleName) ;;Font Height (setq FontHeight 2.5) ;; How to get this from dimstyle selected above (setq FontHght (getreal (strcat "\nEnter Font Height [" (rtos FontHeight)"]: "))) (if (or (= FontHght nil)(= FontHght "")) (setq FontHeight FontHeight) (setq FontHeight FontHght) ) (princ FontHeight) ;;Colours (setq TxtCol 0) ;Text. 0: By Layer, 256: ByBlock (setq Col (getint (strcat "\nEnter Text Colour Code (0: ByLayer, 256: ByBock) [" (rtos TxtCol)"]: "))) (if (or (= Col nil)(= Col "")) (setq TxtCol TxtCol) (setq TxtCol Col) ) (princ TxtCol) (setq LinCol 0) ;Lines. 0: By Layer, 256: ByBlock (setq Col (getint (strcat "\nEnter Lines Colour Code (0: ByLayer, 256: ByBock) [" (rtos LinCol)"]: "))) (if (or (= Col nil)(= Col "")) (setq LinCol LinCol) (setq LinCol Col) ) (princ LinCol) ;;Precision (setq TxtPrecision 4) ; number of decimal places ;; How to get this from dimstyle selected above (setq TxtPrec (getint (strcat "\nEnter Decimal Places) [" (rtos TxtPrecision) "]: "))) (if (or (= TxtPrec nil)(= TxtPrec "")) (setq TxtPrecision TxtPrecision) (setq TxtPrecision TxtPrec) ) (princ TxtPrecision)(princ " DP") (setq DimensionScale (/ FontHeight 2.5)) (jeff1 DimStyleName FontStyleName FontHeight TxtCol LinCol TxtPrecision DimensionScale) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun jeff1 ( DimStyleName FontName FontHeight TxtCol LinCol TxtPrecision DimensionScale / ) ;;Sub Routines (defun mytextstyle ( myfont / mytextstyle fontcount fontlist) ;;check textstyle is loaded ;;Font Style Lists ;;Fontname Height WidthFactor ObliqueAngle Backwards UpsideDown (setq fontstyles (list (list "Standard" "Arial" "0.0000" "1.0000" "0" "No" "No") (list "romans" "romans.shx" "0.0000" "1.0000" "0" "No" "No") ;;Add your own font definitions here ));end fontstyles list (if (member myfont (tableSearch "style")) (princ "Font Is Loaded") (progn ; Font isn't loaded (setq fontcount 0) (while (< fontcount (length fontstyles)) (if (= (strcase (nth 0 (nth fontcount fontstyles))) (strcase myfont)) (progn ;font style is loaded (setq fontlist fontcount) ;;font style exists ) ; end progn ) ;end if (setq fontcount (+ 1 fontcount)) ) (if (= fontlist nil) (progn ;;if font is not defined above or loaded (alert "Font style needs loading. Please edit it") (command "Style" myfont "romans.shx" "0.0000" "1.0000" "0" "No" "No" "No") (initdia) (command "style") ) ;end progn (progn (command "style" (nth 0 (nth fontlist fontstyles)) (nth 1 (nth fontlist fontstyles)) (nth 2 (nth fontlist fontstyles)) (nth 3 (nth fontlist fontstyles)) (nth 4 (nth fontlist fontstyles)) (nth 5 (nth fontlist fontstyles)) (nth 6 (nth fontlist fontstyles)) (nth 7 (nth fontlist fontstyles)) ) ;end command ) ;end progn ) ;end if ) ;end progn );end if (setq mystyle myfont) ;;text font style.. if anything else check if style is loaded into drawing here mystyle ) ;;End Sub Routines (mytextstyle FontName) ;; Check Font exists else make it ;;Full list of dimension variables. ;;Change all or none as required, save and existing style to update ;;NOTE: BYBLOCK and other texts to be numbers? ;;https://help.autodesk.com/view/ACDLTM/2016/ENU/?guid=GUID-30F44A49-4250-42D1-AEF2-5E2914ADB02B ;; List value ;; Default ;;Description (setvar "DIMADEC" TxtPrecision) ;; 0 ;;Angular Dimension Decimal Places ; (setvar "DIMALT" 0) ;; 0 ;;Control of alternative units 0 - Off 1 - On (setvar "DIMALTD" TxtPrecision) ;; 2 / 3 ;;Alternative Units Decimal Places ; (setvar "DIMALTF" 0.0394) ;; 25.4 / 0.0394 ;;Alternative Units Scale Factor ;;(setvar "DIMALTMZF") ;; ;;Alternate sub-zero factor for metric dimensions - Unknown variable ;;(setvar "DIMALTMZS") ;; ;;Alternate sub-zero suffix for metric dimensions - Unknown variable ; (setvar "DIMALTRND" 0.00) ;; 0.00 ;;Alternate units rounding value ; (setvar "DIMALTTD" 3) ;; 2 / 3 ;;Alternative Units Tolerance Decimal Places ; (setvar "DIMALTTZ" 0) ;; 0 ;;Alternate tolerance zero suppression ; (setvar "DIMALTU" 2) ;; 2 ;;Alternative Units Units ; (setvar "DIMALTZ" 0) ;; 0 ;;Alternate unit zero suppression ; (setvar "DIMAPOST" "") ;; "" ;;Prefix and suffix for alternate text ; (setvar "DIMARCSYM" 0) ;; 0 ;;Arc Length Dimension Arc Symbol (setvar "DIMASZ" FontHeight) ;; 0.18 / 2.5 ;;Dimension Line and Leader Line Arrow Heads size ; (setvar "DIMATFIT" 3) ;; 3 ;;Arrow and text fit if distance is too narrow for both ; (setvar "DIMAUNIT" 0) ;; 0 ;;Angular unit format ; (setvar "DIMAZIN" 0) ;; 0 ;;Angular Dimension Depresses leading zeros ; (setvar "DIMBLK" ".") ;; "." ;;Arrow block name "." for closed flled else as properties ; (setvar "DIMBLK1" ".") ;; "." ;;First arrow block name "." for closed flled else as properties ; (setvar "DIMBLK2" ".") ;; "." ;;Second arrow block name "." for closed flled else as properties (setvar "DIMCEN" FontHeight) ;; 0.09 / 2.5 ;;Drawing centre mark for radius or diameter dimensions (setvar "DIMCLRD" LinCol) ;; 0 ;;Colours - Lines, ArrowHeads, Dimension Lines 0: ByLayer, 256 ByBlock (setvar "DIMCLRE" LinCol) ;; 0 ;;Colours - Extension Lines, Centre Marks Colours 0: ByLayer, 256 ByBlock (setvar "DIMCLRT" TxtCol) ;; 0 ;;Colours - Dimension Text Colour 0: ByLayer, 256 ByBlock (setvar "DIMDEC" TxtPrecision) ;; 0 ;;Dimension Decimal Places ; (setvar "DIMDLE" 0) ;; 0.0000 ;;Dimension Line extension with oblique strokes instead of arrows ; (setvar "DIMDLI" 4) ;; 3.75 ;;Dimension Baseline Dimension Spacing (setvar "DIMDSEP" ".") ;; . ;;Decimal separator (setvar "DIMEXE" (/ Fontheight 2)) ;; 0.18 / 1.25 ;;Extension Line Extension distance (setvar "DIMEXO" (/ Fontheight 4)) ;; 0.0625 / 0.625 ;;Extension Line Offset ; (setvar "DIMFRAC" 0) ;; 0 ;;Dimension Fraction Format ; (setvar "DIMFXL" 1.00) ;; 1 ;;Fixed Extension Line ; (setvar "DIMFXLON" 0) ;; 0 ;;Enable Fixed Extension Line 0 - Off 1 - On (setvar "DIMGAP" (/ FontHeight 4)) ;; 0.09 / 0.625 ;;Dimension gap between text and arrow (setvar "DIMJOGANG" (* pi (/ 45 180.0))) ;; ;;Radius dimension jog angle.. radians? ; (setvar "DIMJUST" 0) ;; 0 ;;Justification of text on dimension line (setvar "DIMLDRBLK" ".") ;; "." ;;Leader block name "." for closed flled else as properties ; (setvar "DIMLFAC" 1.00) ;; 1 ;;Linear unit scale factor ; (setvar "DIMLIM" 0) ;; 0 ;;Generate dimension limits 0 - Off 1 - On (setvar "DIMLTEX1" "BYBLOCK") ;; "." ;;Linetype extension line 1 (setvar "DIMLTEX2" "BYBLOCK") ;; "." ;;Linetype extension line 2 (setvar "DIMLTYPE" "BYBLOCK") ;; "." ;;Dimension linetype ; (setvar "DIMLUNIT" 2) ;; 2 ;;Dimension Units (except angular) - number type ; (setvar "DIMLWD" -2) ;; -2 ;;Dimension Line Lineweights ; (setvar "DIMLWE" -2) ;; -2 ;;Extension Line Line Weight ;;(setvar "DIMMZF") ;; ;;Sub-zero factor for metric dimensions - Unknown variable ;;(setvar "DIMMZS") ;; ;;Sub-zero suffix for metric dimensions - Unknown variable ; (setvar "DIMPOST" "") ;; "" ;;Prefix and suffix for dimension text ; (setvar "DIMRND" 0) ;; 0 ;;Dimension Round distance to nearest n ; (setvar "DIMSAH" 0) ;; 0 ;;Separate arrow blocks 0 - Off 1 - On ; (setvar "DIMSCALE" 1) ;; 1 ;;Dimension Scale Factor ; (setvar "DIMSD1" 0) ;; 0 ;;Suppress the first dimension line 0 - Off 1 - On ; (setvar "DIMSD2" 0) ;; 0 ;;Suppress the second dimension line 0 - Off 1 - On ; (setvar "DIMSE1" 0) ;; 0 ;;Suppress the first extension line 0 - Off 1 - On ; (setvar "DIMSE2" 0) ;; 0 ;;Suppress the second extension line 0 - Off 1 - On ; (setvar "DIMSOXD" 0) ;; 0 ;;Suppress outside dimension lines ; (setvar "DIMTAD" 0) ;; 0 ;;Dimension Text Vertical distance ; (setvar "DIMTDEC" 4) ;; 4 ;;Tolerance decimal places ; (setvar "DIMTFAC" 1) ;; 1 ;;Dimension text scale factor of fractions relative to text height ; (setvar "DIMTFILL" 0) ;; 0 ;;Text background enabled ; (setvar "DIMTFILLCLR" 0) ;; 0 ;;Text background color 0: ByLayer, 256 ByBlock ; (setvar "DIMTIH" 0) ;; 0 ;;Text inside extensions is horizontal 0 - Off 1 - On ; (setvar "DIMTIX" 0) ;; 0 ;;Place text inside extensions 0 - Off 1 - On ; (setvar "DIMTM" 0) ;; 0 ;;Dimension Minus tolerance distance when used with dimtol, or dimlim ; (setvar "DIMTMOVE" 0) ;; 0 ;;Text movement ; (setvar "DIMTOFL" 0) ;; 0 ;;Force line inside extension lines 0 - Off 1 - On ; (setvar "DIMTOH" 1) ;; 1 ;;Text outside horizontal 0 - Off 1 - On ; (setvar "DIMTOL" 0) ;; 0 ;;Tolerance dimensioning 0 - Off 1 - On ; (setvar "DIMTOLJ" 1) ;; 0 ;;Tolerance vertical justification ; (setvar "DIMTP" 0) ;; 0 ;;Dimension Plus tolerance distance when used with dimtol, or dimlim ; (setvar "DIMTSZ" 0.00) ;; 0 ;;Tick size ; (setvar "DIMTVP" 0.00) ;; 0 ;;Text vertical position (setvar "DIMTXSTY" FontName) ;; Font ;;Text style (setvar "DIMTXT" FontHeight) ;; 0.18 / 2.5 ;;Dimension text Height ;;(setvar "DIMTXTDIRECTIONOff" 0) ;; ;;Dimension text direction 1 or 0 - NOT SURE IF THIS WORKS ; (setvar "DIMTZIN" 8) ;; 8 ;;Suppresses leading zeros in tolerance values ; (setvar "DIMUPT" 0) ;; 0 ;;User positioned text 0 - Off 1 - On ; (setvar "DIMZIN" 8) ;; 8 ;;Suppresses leading zeroes ;;Set Dimstyle named above to this list (setq dimstylelist (tableSearch "dimstyle")) (if (= (member DimStyleName dimstylelist) nil) (command "dimstyle" "s" DimStyleName) (command "dimstyle" "s" DimStyleName "Y") ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hope that sets you on your way a little Edit: Last snippet. If you want to get the entity name of a font style, which you can apply to the add xdata portion from my first code to add annotative to an existing font. (defun c:GetTextStyle ( FontName / ) (Entget (tblobjname "style" FontName)) ;;(entget (tblobjname "Style" FontName) '("AcadAnnotative")) ;; Lists registered app AcadAnnotative entries )

Then you need to upgrade or follow my recommendation on searching the web for workarounds. I gave you a start with two relevant links.

Start with the profiles on the vertical back plane (XZ world) then extrude. Add consruction lines to define regions. Extrude regions, substract cylinders and union it all together.

My thought exactly. It looks like an Impossible Object.