Leaderboard

[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

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

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

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

I also think this thread has been stimulating. The final result should be useful for other users in the future. Regarding your approach, I agree; it's the best way to achieve an axis with perfectly centered segments. All that remains is to write the code that can do all of that without Express Tools.

@Steven P that works way better than i dreamed... even if you say its a bit dirty... Being able to select the intersection of datum and reference line, and the scaling option is brilliant.. If i had a box of Jaffa Cakes they would be in your hands right now.... Thank you soo much.... @BIGAL thank you for the reply and i think i understand what you mean... but i need to leave some work for my understudy to do can't speed him up too much.....

I think this is something that Civil3D covers - BigAl knows these things better than me though. This is a very quick and dirty LISP: Noting that your lines are 1000x longer than the reference texts, I have a multiplier (hit enter to just accept the 1000, you can change the code to suit) Select the reference polyline - I am assuming always a horizontal reference line as your example Select the point that the height texts refer to (is it the centre of the '+', in the drawing there is a point drawn at the correct height next to each text) and then the associated text. Repeat along the points Exit badly with the escape key. I am going to get abuse for cutting corners there... Slight difference to your example that my lines are drawn from the closest point on the polyline that you selected (defun c:test ( / Multiplier ReferencePoly ReferenceY EndLoop MyPoint MyHeight MyHt ClosestPoint) (defun MkLn ( pt1 pt2 Layer / Ln ) ;; Add in layer etc details (setq Ln (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(62 . 0) '(100 . "AcDbLine") (cons 8 Layer) (cons 6 "CONTINUOUS") (cons 62 256) (cons 10 pt1) (cons 11 pt2) '(210 0.0 0.0 1.0) ))) ; end list, entmakex, setq ) (setq Multiplier (getreal "Enter Height Multiplier (1000)")) (if (or (= Multiplier nil)(= Multiplier "")(= Multiplier 0)) (setq Multiplier 1000) ) (setq ReferencePoly (car (entsel "Select Reference Polyline"))) (setq ReferenceY (cdr (assoc 10 (entget ReferencePoly)))) (setq EndLoop "No") (while (= EndLoop "No") (setq MyPoint (getpoint "Select Point")) (setq MyHeight (car (entsel "Select Height text"))) (setq MyHt (cdr (assoc 1 (entget MyHeight)))) (setq ClosestPoint (vlax-curve-getclosestpointto ReferencePoly MyPoint)) (MkLn ClosestPoint (mapcar '* '(1 1 0) (mapcar '+ (list 0 (* Multiplier (atof MyHt)) 0) ClosestPoint)) "0") ) )

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)

Thinking I understood that one.... In my attempt (sorry folks haven't had a chance to look at it this week yet) I was half way here, created a temp poly line mid point between poly 1 end points and closest on poly 2. Created a list of points mid point from poly 2 to closest point on poly 1 (the reverse) then ent mod the temp poly adding in new points as required... it didn't work 100%. Tried to think how to combine the 2 lists of points (1 to 2, 2 to 1). Point at Param might be the one to go for. Spanner in the works... what happens if the end points are not aligned, example closed polylines, first point on poly 1 say at the 12:00 position, first point on poly 2 say at 3:00 position? - think it will work OK

https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/2/#findComment-676816 The last code i posted works well on two open polylines. its just when they loop back on themselves that only checking the distance gets points get out of order. haven't had time to code but I think I have a solution creating a dotted pair list.

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

Here is my first attempt at this problem. It creates offset lines and checks the intersections. The precision is dictated by the offsetdistance. The lower it is, the longer it takes to make the polyline and the more points it will have. But it will be more accurate. Afterwards I run this function on the resulting polyline to clean it up. ;| ; Center line - dexus ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel |; (defun c:testcl (/ ent1 lst offset offsetdistance pts r s1 s2 ss start te1 te2) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) 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)) ) (if (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 ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) (progn (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2))) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1))) (setq maxlen (max (getLength ent1) (getLength ent2))) (setq offset 0.0) (setq offsetdistance (/ maxlen 1024.0)) (while (progn (setq offset (+ offset offsetdistance)) (setq te1 nil) (setq te2 nil) (setq r (cond ( (or ; Make offset (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if s1 offset (- offset)))))) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if s2 offset (- offset)))))) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq len (getLength (car te1))) (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint (car te1) pt) len) pt))) lst)) (setq start t) (setq pts (append lst pts)) ) ((> offset maxlen) nil) ((not start) t) (start nil) ) ) (if te1 (mapcar 'vla-delete te1)) (if te2 (mapcar 'vla-delete te2)) r ) ) (if pts (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b))))))) ) ) ) )

Hi Omar. Bienvenido Try this (defun strpto (aa / largo) (setq largo (strlen aa)) (cond ((< largo 4) aa) ((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3))) ((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3) ) ) (t aa) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DatosLineas : obtiene los coeficientes necesarios para determinar las ;; rectas que definen el area a cuadricular. Las cuales son ;; de la forma : a*x + b*y = c ;; (Defun DatosLineas (p1 p2 p3 p4) (setq a1 (- (cadr p2) (cadr p1)) a2 (- (cadr p4) (cadr p2)) a3 (- (cadr p3) (cadr p4)) a4 (- (cadr p1) (cadr p3)) b1 (- (car p1) (car p2)) b2 (- (car p2) (car p4)) b3 (- (car p4) (car p3)) b4 (- (car p3) (car p1)) c1 (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) c2 (- (* (car p2) (cadr p4)) (* (car p4) (cadr p2))) c3 (- (* (car p4) (cadr p3)) (* (car p3) (cadr p4))) c4 (- (* (car p3) (cadr p1)) (* (car p1) (cadr p3))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Punto de la recta dada por a,b,c dada la cordenada Y ;; (Defun CalculaX (a b c y) (if (= 0.0 a) ; no hay interseccion nil (/ (- c (* b y)) a) ) ) (Defun IntersecX (/ l lista) (setq l () lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY) (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY) ) ) (while (/= lista nil) (setq x (car lista)) (if (and (/= x nil) (<= x maxX) (>= x minX)) (setq l (append l (list x))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Interseccion dada la cordenada X ;; (Defun CalculaY (a b c x) (if (= 0.0 b) ; no hay interseccion nil (/ (- c (* a x)) b) ) ) (Defun IntersecY (/ l lista) (setq l () lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX) (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX) ) ) (while (/= lista nil) (setq y (car lista)) (if (and (/= y nil) (<= y maxY) (>= y minY)) (setq l (append l (list y))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) (defun dameEsquinas (e / le lp) (if (= (cdr (assoc 0 (setq le (entget e)))) "LWPOLYLINE") (foreach l le (if (= (car l) 10) (setq lp (cons (cdr l) lp)) ) ) ) (if lp (vl-sort lp '(lambda(a b) (< (car a) (car b))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Programa principal ;; (Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base alfa startX startY minX minY maxX maxY ) (setvar "CMDECHO" 0) (command "_.undo" "_begin") (command "osnap" "off") (command "units" "2" "3" "3" "4" "e" "n") (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "") (command "style" "romand" "romand" 0 1 0 "N" "N" "N") (setq incrx 0) ;;; (setq p1 (getpoint "\nIngrese un vertice de la region ") ;;; p2 (getpoint p1 "\nIngrese el otro vertice ") ;;; ) ;;; (command "LINE" p1 p2 "") (if (not (setq e (car (entsel "\nSelecciona el marco para la grilla...")))) (exit) ) (setq l (dameEsquinas e) p1 (car l) p2 (cadr l) p3 (caddr l) l nil ) (if (> (cadr p1) (cadr p2)) ; siempre el p1 abajo (setq paux p1 p1 p2 p2 paux ) ) (setq p3 (getpoint p1 "\nIngrese punto para Ancho de la region ") l (distance p1 p3) ; calculo de puntos p3 y p4 , paralelos alfa (angle p1 p2) ; a p1 y p2 a distancia l alfa (+ (/ pi 2) alfa) ) (if (> (car p3) (car p1)) (setq alfa (+ pi alfa)) ) (if (= (car p1) (car p3)) (if (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) 0.0) (setq alfa (+ pi alfa)) ) ) (setq p3 (list (+ (car p1) (* l (cos alfa))) (+ (cadr p1) (* l (sin alfa))) ) p4 (list (+ (car p2) (* l (cos alfa))) (+ (cadr p2) (* l (sin alfa))) ) ) (command "LINE" p1 p2 p4 p3 "C") ; marco exterior (if (< (cadr p3) (cadr p1)) ; punto1 siempre mas bajo (setq paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux ) ) (setq minX (min (car p2) (car p3)) maxX (max (car p2) (car p3)) minY (cadr p1) maxY (cadr p4) l (- maxX minX) h (- maxY minY) malDato 1 ) (while (= malDato 1) (setq incx (getreal "\nIncremento malla (m) :")) (if (< (abs (/ l 3)) incrx) (print "\nIncremento muy grande") (setq malDato 0) ) ) (setq incy incx) (setq n (fix (/ minX incx)) ; posiciones donde comenzar startX (* (1+ n) incx) ; el cuadriculado n (fix (/ minY incy)) ; tanto en X como en Y startY (* (1+ n) incy) largoMax (max (distance p1 p3) ; el largo maximo de la region (distance p1 p4) ) ) (if (< minX 0) (setq startX (- startX incx)) ) (if (< minY 0) (setq startY (- startY incy)) ) (setq ff (getreal "\nIngrese Alto (mm) :")) (setq escala (getreal "\nEscala : ")) (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres (setq angP1P3 (angle p1 p3) angP1P2 (angle p1 p2) angBorde (min (abs angP1P3) (abs angP1P2)) dh (min (/ incx 40.0) (/ incy 40.0)) x1 minX ; el caso en que no hay que rotar x2 maxX y1 minY y2 maxY ) (if (or (= (cadr p1) (cadr p2)) (= (car p1) (car p3)) (= (car p1) (car p2)) ) (setq revisar 0 dl (min (/ incx 30.0) (/ incy 30.0)) ) (setq revisar 1 dl (* (* alto (/ (cos angBorde) (sin angBorde))) 2) ) ) (DatosLineas p1 p2 p3 p4) (while (< startY maxY) (if (= revisar 1) (setq ptos (IntersecX) x1 (car ptos) x2 (cadr ptos) ) ) (setq coordY (rtos startY 2 0) coordY (strcat "N-" (strpto coordY)) ) (command "LINE" (list x1 startY) (list x2 startY) "") (cond ((> (- maxY startY) (* 2 alto)) (command "TEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY ) (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY ) ) ) (setq startY (+ startY incy)) ) (while (< startX maxX) (if (= revisar 1) (setq ptos (IntersecY) y1 (car ptos) y2 (cadr ptos) ) ) (setq coordX (rtos startX 2 0) coordX (strcat "E-" (strpto coordX)) ) (command "LINE" (list startX y1) (list startX y2) "") (cond ((> (- startX minX) (* 2 alto)) (command "TEXT" (list (- startX dh) (+ y1 dl)) alto 100 coordX ) (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX ) ) ) (setq startX (+ startX incx)) ) (if (> (distance p1 p3) (distance p1 p2)) (setq alfa angP1P3) (setq alfa angP1P2) ) (if (or (/= alfa pi) (/= alfa 0.0)) (setq alfarad (* -1 alfa) alfa (* -1 (/ (* 200 alfa) pi)) p4 (list (- (* (car p4) (cos alfarad)) (* (cadr p4) (sin alfarad))) (+ (* (car p4) (sin alfarad)) (* (cadr p4) (cos alfarad))) ) p1 (list (- (* (car p1) (cos alfarad)) (* (cadr p1) (sin alfarad))) (+ (* (car p1) (sin alfarad)) (* (cadr p1) (cos alfarad))) ) base (list 0.0 0.0) ; el origen ) ) (command "_.undo" "end") (command "_.undo" "auto" "on") ;; (command "units" "2" "3" "3" "4" "n" "y") ) The "command" calls in your code are designed for an English version of AutoCAD, and mine is in Spanish. For this reason, and due to lack of time, I haven't tested the code sufficiently. Try it yourself and then comment on the results.

I also deleted your posts in the old thread you resurrected, no need for having a conversation in two separate threads.

Where did you get the UK version? This was originally Australian and USA, it was modified in 2017 for UK by www.stylemarkdesigns.co.uk (that website is no longer active). I use the original AL's Steel Mill, the Wisey's I have was last modified in 2013, that update is missing in your version. My best guess would be there is some incomplete UK data, you should look at the Aus and USA supplied data and compare.

Another version just drag over the plines left and right. https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw (ent / area1 area2 dist lst obj objnew pointmax pointmin) (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (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) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put obj 'coordinates lst) ) ) (setvar 'osmode oldsnap) (princ) ) (c:wow)

Need a Plan dwg showing the line work etc this will give some clues about the extra points that you want highlite those points in the Plan dwg, to really get an proper answer need a full CIV3D dwg not just a output setcion so a CIV3D user can run the make long and cross sesctions.

Edited Not quite there yet, will draw points at the mid points between each coordinate in the polylines and the closest point in the other. Draws a poly line connecting most of them... but not quite... Something odd if you select the polylines in the wrong order. Results are similar to what others have. No account taken for arcs yet (defun c:PolyMD ( / acount MyPoly1 MypolyEnt1 MyPolyVert1 MyPoly2 MypolyEnt2 MyPolyVert2 pt pt1 pt2 PtList1 PtList2 pnt NewPoly NewPolyEnt) ;;; Sub functions ;;;;;; ;;https://www.cadtutor.net/forum/topic/87445-help-add-vertex-to-polyline/ (defun add_vtx (obj add_pt ent_name / sw ew nw bulg) (vla-GetWidth obj (fix add_pt) 'sw 'ew) (vla-addVertex obj (1+ (fix add_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) ) ) ) ) (setq nw (* (/ (- ew sw) (- (vlax-curve-getdistatparam obj (1+ (fix add_pt))) (vlax-curve-getdistatparam obj (fix add_pt))) ) (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt))) ) bulg (atan (vla-GetBulge obj (fix add_pt))) ) (vla-SetBulge obj (fix add_pt) (/ (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25)) (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) ) ) (vla-SetWidth obj (fix add_pt) sw (+ nw sw) ) (vla-SetWidth obj (1+ (fix add_pt)) (+ nw sw) ew ) (vla-update obj) ) (defun add_vtx@point (ename lst_pt / n ename obj dxf_10 pt_brk l_tst) (setq obj (vlax-ename->vla-object ename)) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ename)))) (foreach el (mapcar '(lambda (x) (trans x 0 ename)) lst_pt) (setq pt_brk (trans (vlax-curve-getClosestPointTo ename (trans el ename 0) nil) 0 ename)) (setq l_tst (vl-member-if '(lambda (x) (and (equal (car x) (car pt_brk) 1E-08) (equal (cadr x) (cadr pt_brk) 1E-08))) dxf_10)) (if (and (equal pt_brk el 1E-08) (not (eq (length l_tst) 1)) (not (eq (length l_tst) (length dxf_10))) ) (progn (setq lst_brk (cons pt_brk lst_brk)) (if (zerop (length l_tst)) (add_vtx obj (vlax-curve-getparamatpoint ename (trans pt_brk ename 0)) ename) ) ) ) ) ) (defun mAssoc ( key lst / result ) (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) ; end Massoc (defun midpt (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) ) ) (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) (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 MakePoly (PtLst PolyClose / ) (princ "Close: ")(princ PolyClose) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length PtLst)) ;; (cons 70 PolyClose) ) (mapcar (function (lambda (p) (cons 10 p))) PtLst) )) ) (defun MakePoint ( pt / ) (entmakex (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 pt) )) ) (defun MakeLine (pt1 pt2 / ) (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 pt1) (cons 11 pt2) )) ) ;;;;;;; end sub functions ;;;;;;; (setq MyPoly1 (car (entsel "\nSelect Outer Polyline: "))) (setq MyPoly1Ent (entget MyPoly1)) (setq MyPoly1Vert (mAssoc 10 MyPoly1Ent)) (setq MyPoly2 (car (entsel "\nSelect Inner Polyline 2: "))) (setq MyPoly2Ent (entget MyPoly2)) (setq MyPoly2Vert (mAssoc 10 MyPoly2Ent)) (foreach pt MyPoly1Vert (setq pt2 (vlax-curve-getclosestpointto MyPoly2 pt)) (setq PtList1 (cons (midpt pt pt2) PtList1)) ) ; end foreach (setq NewPoly (MakePoly PtList1 (cdr (assoc 70 MyPoly1Ent)))) (setq NewPolyEnt (entget NewPoly)) (foreach pt MyPoly2Vert (setq pt1 (vlax-curve-getclosestpointto MyPoly1 pt)) (setq NewLine (makeline pt pt1)) (setq PtList2 (cons (midpt pt pt1) PtList2)) (setq pnt (car (LM:intersections (vlax-ename->vla-object NewLine) (vlax-ename->vla-object NewPoly) acextendnone))) (setq pnt (list (car pnt) (cadr pnt))) (add_vtx@point NewPoly (list pnt)) (setq NewPolyEnt (entget NewPoly)) (setq NewPolyEnt (subst (cons 10 (midpt pt pt1) ) (cons 10 pnt) NewPolyEnt )) (entmod NewPolyEnt) ;; (entupd NewPoly) (command "erase" NewLine "") ) ; end foreach (foreach pt PtList1 (Makepoint pt) ) (foreach pt PtList2 (Makepoint pt) ) ;;Work out if midpoints outside of exterior polyline (in case of complicated shapes) ;;Work out polyline bulges ;;If closed poly, add end vertex (princ) )

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 )

Here's a simpe solution that doesn't use LISP. Change the elevation of one of the polylines to 1.0 then use the loft command to create asurface. Section the resulting surface with an XY plane at 0,0,0.5.

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.