Leaderboard

Calculating an axis using angle bisectors a) Attempt number 1 (it was my first impulse, but I came up with a better one later) Advantages: - Pure LISP: doesn't depend on Express Tools, - It's faster Disadvantages: - The result isn't as good as @GP_'s "c:CPL" - It only accepts LWPOLYLINES and ignores arcs Basically, the approach is to obtain angle bisectors on each polyline, extend them to the other reference polyline, and use their midpoints. The result is acceptably good, but not as accurate as c:CPL. (defun c:creAxis (/ e e1 e2 l1 l2 lr p p0 p1 p2 px pm abis lii pmi pfi pi1 pi2 pf1 pf2 dameInters+Prox ordena) (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 (pr lp / d dmin ps lr) (while lp (foreach p lp (if dmin (if (< (setq d (distance p pr)) dmin) (setq dmin d ps p) ) (setq dmin (distance p pr) ps p) ) ) (setq dmin nil pr ps lp (vl-remove ps lp) lr (append lr (list ps))) ) ) (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; ) (if (< (distance (setq pi1 (cdr (assoc 10 l1))) (setq pi2 (cdr (assoc 10 l2)))) (distance pi1 (setq pf2 (cdr (assoc 10 (reverse l2)))))) (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pi2) pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (setq pf1 (cdr (assoc 10 (reverse l1)))) pf2) ) (setq pmi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pi1 pf2) pfi (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (cdr (assoc 10 (reverse l1))) pi2) ) ) (redraw e1 4) (redraw e2 4) (foreach l l1 (if (= (car l) 10) (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2) (/ PI 2.)) x (princ) px (dameInters+Prox p2 abis lp2) lr nil pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px)) lii (if px (append lii (list pm)) lii) p1 p2 p2 (cdr l) ) (setq p2 (cdr l)) ) (setq p1 (cdr l)) ) ) ) (setq p1 nil p2 nil lr nil) (foreach l l2 (if (= (car l) 10) (if p1 (if p2 (setq abis (+ (/ (+ (angle p1 p2) (angle p2 (cdr l))) 2.) (/ PI 2.)) px (dameInters+Prox p2 abis lp1); pm (if px (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 px) (princ) ) lii (if px (append lii (list pm)) lii); p1 p2 p2 (cdr l) ) (setq p2 (cdr l)) ) (setq p1 (cdr l)) ) ) ) (setq lii (append (list pmi) (ordena pmi lii) (list pfi))) ) ) ) (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) ) PS: It seems to work well, but I haven't tested it extensively. As I said at the beginning, there's a better approach, using angle bisectors, which I'll publish later.

I lost the post but found the answer, the question was how to keep a notepad window always on top of the CAD window. I did a google and found a Microsoft product. Admin please move if find other post. https://learn.microsoft.com/en-us/windows/powertoys/always-on-top You need to download and install then restart but works, tried with Bricscad.

Thought we were getting tolled when i saw @GP_ GIF had to double take on the original posted dwg.

Seneca said: “Homines dum docent discunt.” Which, roughly, means: Learn to explain and explain to learn

Updated code here

A version also for closed polylines. Minimally tested... centerPline_v2.LSP

It will require more modification than just extending the bulge list - you also need to calculate the positions of the additional vertices. However, I really liked your suggestion (and it's also consistent with my existing Box Text program), and so I've updated the program to Version 1.3 to incorporate a new Filleted Rectangle textbox option (you may need to refresh the page to view the new version). Enjoy!

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.

@JerryFiedler look at fanzy zone that is also part of powertoys. its the whole reason i got it when it first came out.

Thanks @Steven P I guess you're right. Anyway, I'll try to keep this thread going a little longer to give others time to make their suggestions.

OK!! Thanks you so much for remind me.

Just for fun, a slight different way to set variables, I like the dotted pair listing to tie in variable name and its short description. Could be expanded as basic lists with the last item being the 'get' function (string, int, distance....) for different types using read and eval [ (list "ard" "Approach Radius" "getDist") ] (defun c:setvariables ( / acount ard crd erd aof eof ) (setq VariablesList (list (cons "ard" "Approach Radius") (cons "crd" "Center Radius") (cons "erd" "End Radius") (cons "aof" "Approach Offset") (cons "eof" "Tie In Offet") )) ; end list, end setq (foreach n VariablesList (setq MyX (getDist (strcat "\nSet " (cdr n) ": "))) (eval (read (strcat "(setq " (car n) " " (vl-princ-to-string MyX) ")" ))) ) ; end foreach ) (defun c:setvariables ( / acount ard crd erd aof eof ) (setq VariablesList (list (list "ard" "Approach Radius" "getdist") (list "crd" "Center Radius" "getdist") (list "erd" "End Radius" "getdist") (list "aof" "Approach Offset" "getdist") (list "eof" "Tie In Offet" "getdist") )) ; end list, end setq (foreach n VariablesList (setq MyX ( (eval (read (last n))) (strcat "\nSet " (cadr n) ": "))) (eval (read (strcat "(setq " (car n) " " (vl-princ-to-string MyX) ")" ))) (if (= (last n) "getstring") ; fix for strings (eval (read (strcat "(setq " (car n) " \"" (vl-princ-to-string MyX) "\")" ))) ) ) ; end foreach ) Couple of edits for typos

replace ;;----------------------------------------------------------------------;; (vl-every '(lambda ( sym msg ) (initget 6) (set sym (getdist msg))) '(ard crd erd aof eof) '("\nSpecify approach radius: " "\nSpecify center radius: " "\nSpecify end radius: " "\nSpecify approach offset: " "\nSpecify tie-in offset: " ) ) ;;----------------------------------------------------------------------;; with ;;----------------------------------------------------------------------;; (setq crd (getdist "\nMiddle Radius: ") ard (* 2 crd) ; Approach radius erd (* 3 crd) ; Exit radius aof (* 0.0375 crd) ; Approach offset eof (* 0.1236 crd) ; Exit offset ) ;;----------------------------------------------------------------------;; Tho that is pretty cool way to set a bunch of variables with lambda

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 )

If I get any time at home, I'll do some testing in AutoCAD 2000i.

Try mine...

It's true... sorry I'm curious to see if there are any differences.

100% agree. I'd take BIGAL's route but idk if it would suffer from the same issue as my first screenshot. but the macro could be used to update old drawings easily. Coming from cad one of my main grips about solidworks was the customization and how you had to go digging around menus to change things. But I inderstand why it's that way. Did see if you had a dimension selected in the option panel you could go to other tab > override > feet inch and it would use like 3' - 6“ but if it was less than 12" it would only use in. Our drawings only show the number and just have a note in the title block saying. all dimensions are in inches unless otherwise called out. We have some Europe contracts so we will have to do things in metric from time to time.

Yes, GP_'s need Express Tools AFAIK. As I posted, It still is off from yours on some corners. It also creates lines and splines, though easy enough to make them polylines.

sample of this import traceback import re from pyrx import Db, Ed, Ge, Ap, Rx, Gs def extract_num(s: str): match = re.search(r'\d+', s) if match: return int(match.group()) return -1 @Ap.Command() def doit(): try: # select db = Db.curDb() filter = [(Db.DxfCode.kDxfStart, "TEXT,LWPOLYLINE")] ps, ss = Ed.Editor.select(filter) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) texts = [Db.Text(id) for id in ss.objectIds(Db.Text.desc())] plines = [Db.Polyline(id) for id in ss.objectIds(Db.Polyline.desc())] # make kdtree & list of points pntmap = {} plpoints = [] for pl in plines: plpoints.append(pl.getStartPoint()) plpoints.append(pl.getEndPoint()) pntmap[pl.getStartPoint()] = pl pntmap[pl.getEndPoint()] = pl # search closest pline results = [] tree = Ge.Point3dTree(plpoints) for text in texts: idxs, _ = tree.knnSearch(text.position(), 1) pl: Db.Polyline = pntmap[plpoints[idxs[0]]] results.append([text.textString(), pl.getDistAtParam(pl.getEndParam())]) # format mtext results = sorted(results, key=lambda x: extract_num(x[0])) buffer = "{:<6}\t{}\\P".format("S.No", "Length Ft") buffer += "".join(f"{sno:<6}\t {plen:>.2f}\\P" for sno, plen in results) # make mtext, add to currentSpace ps, pnt = Ed.Editor.getPoint("\nPick Text Position") mt = Db.MText() mt.setDatabaseDefaults(db) mt.setLocation(pnt) mt.setContents(buffer) cs = db.currentSpace(Db.OpenMode.kForWrite) cs.appendAcDbEntity(mt) except Exception as err: traceback.print_exception(err)

see https://github.com/CEXT-Dan/PyRx

For these examples, I’ll be working with a folder with copies of the same drawing, pretend they’re floors of the same building or something

Working with the layout manager in a side database context, LayoutManager methods have overloads that take a database argument import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs from timeit import default_timer as timer from collections import defaultdict def processDWG(db: Db.Database, allLayouts: dict[list]): lm = Db.LayoutManager() # LayoutManager methods have overloads that take a database argument # here we just want to get the layout names for layoutName, LayoutId in lm.getLayouts(db).items(): allLayouts[db.getFilename()].append(layoutName) # example if we want to search for title blocks # ignore the model tab if not "MODEL".casefold() in layoutName.casefold(): layout = Db.Layout(LayoutId) ps = Db.BlockTableRecord(layout.getBlockTableRecordId()) for id in ps.objectIds(Db.BlockReference.desc()): ref = Db.BlockReference(id) print(ref.getBlockName()) def readDWG(file: str, allLayouts): sideDb = Db.Database(False, True) sideDb.readDwgFile(file) sideDb.closeInput(True) processDWG(sideDb, allLayouts) @Ap.Command() def doit(): try: start = timer() allLayouts = defaultdict(list) for file in Ap.Application.listFilesInPath("E:\\temp", ".dwg"): readDWG(file, allLayouts) print("Time = {} seconds: ".format(timer() - start)) for k, v in allLayouts.items(): print(k, v) except Exception as err: traceback.print_exception(err) Command: DOIT Project data <--- a block I added to paperspace, could be a title block Time = 0.0780531999989762 seconds: E:\temp\Floor Plan Sample1.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample2.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample3.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample4.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample5.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample6.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample7.dwg ['Layout1', 'Model'] E:\temp\Floor Plan Sample8.dwg ['Layout1', 'Layout2', 'Model']

The working database https://help.autodesk.com/view/OARX/2025/ENU/?guid=OARX-RefGuide-AcDbHostApplicationServices__workingDatabase AcDbHostApplicationServices::workingDatabase AcDbHostApplicationServices::setWorkingDatabase It’s mostly legacy stuff at this point; there are some function calls in ObjectARX that do not have a database parameter. They work assuming that that the working database has been set. This is the same sample as above, but we use AutoWorkingDatabase import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs from timeit import default_timer as timer from collections import defaultdict def processDWG(allphones: dict[int]): # shortcut to # Db.HostApplicationServices.workingDatabase() db = Db.workingDb() refs = [Db.BlockReference(id) for id in db.objectIds(Db.BlockReference.desc())] for ref in refs: if ref.getBlockName() != "FNPHONE": continue allphones[db.getFilename()] += 1 def readDWG(file: str, allphones): sideDb = Db.Database(False, True) sideDb.readDwgFile(file) sideDb.closeInput(True) # use RAII to set and restore the working db wdb = Db.AutoWorkingDatabase(sideDb) processDWG(allphones) @Ap.Command() def doit(): try: start = timer() # read all text from a collection of drawings allphones = defaultdict(int) for file in Ap.Application.listFilesInPath("E:\\temp", ".dwg"): readDWG(file, allphones) print("Time = {} seconds: ".format(timer() - start)) for k, v in allphones.items(): print(k, v) except Exception as err: traceback.print_exception(err) same output Command: DOIT Time = 0.12193889999980456 seconds: E:\temp\Floor Plan Sample1.dwg 51 E:\temp\Floor Plan Sample2.dwg 51 E:\temp\Floor Plan Sample3.dwg 51 E:\temp\Floor Plan Sample4.dwg 51 E:\temp\Floor Plan Sample5.dwg 51 E:\temp\Floor Plan Sample6.dwg 51 E:\temp\Floor Plan Sample7.dwg 51 E:\temp\Floor Plan Sample8.dwg 51

If you notice, everywhere a class or function returns an objectId collection, you can apply a type filter refs = [Db.BlockReference(id) for id in db.objectIds(Db.BlockReference.desc())]

One thing to keep in mind, is that way python’s garbage collector works; First created, First deleted. We want to break up the functions to ensure that the side database is not deleted before any of it’s objects. This example, we will iterate though all eight files and count the number of phones by floor import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs from timeit import default_timer as timer from collections import defaultdict def processDWG(db: Db.Database, allphones: dict[int]): # scan the entire database for blocks, this is a tad slower than just scanning # modelspace refs = [Db.BlockReference(id) for id in db.objectIds(Db.BlockReference.desc())] for ref in refs: if ref.getBlockName() != "FNPHONE": continue allphones[db.getFilename()] += 1 def readDWG(file: str, allphones): # we reading an already created drawing, so change # buildDefaultDrawing: bool = False, # noDocument: bool = True # we want to keep this in a seperate function sideDb = Db.Database(False, True) sideDb.readDwgFile(file) sideDb.closeInput(True) processDWG(sideDb, allphones) @Ap.Command() def doit(): try: start = timer() # read all text from a collection of drawings allphones = defaultdict(int) for file in Ap.Application.listFilesInPath("E:\\temp", ".dwg"): readDWG(file, allphones) print("Time = {} seconds: ".format(timer() - start)) for k, v in allphones.items(): print(k, v) except Exception as err: traceback.print_exception(err) Command: DOIT Time = 0.1402779999998529 seconds: E:\temp\Floor Plan Sample1.dwg 51 E:\temp\Floor Plan Sample2.dwg 51 E:\temp\Floor Plan Sample3.dwg 51 E:\temp\Floor Plan Sample4.dwg 51 E:\temp\Floor Plan Sample5.dwg 51 E:\temp\Floor Plan Sample6.dwg 51 E:\temp\Floor Plan Sample7.dwg 51 E:\temp\Floor Plan Sample8.dwg 51

Better late the never this will add a " to the end of dimensions for a drawing that is set to IPS. tho doesn't work quite right when tolerances are used. will also prompt you if you are going to overwrite any data Sub addtick() Dim swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swDraw As SldWorks.DrawingDoc Dim swView As SldWorks.View, swDispDim As SldWorks.DisplayDimension, swDim As SldWorks.Dimension Dim unitSystem As Long, okRun As Boolean, sCurrSuffix As String, id As String Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc If swModel Is Nothing Then MsgBox "No active document.", vbExclamation, "Add Inch Tick" Exit Sub End If If swModel.GetType <> swDocDRAWING Then MsgBox "This macro only runs on drawings.", vbExclamation, "Add Inch Tick" Exit Sub End If unitSystem = swModel.Extension.GetUserPreferenceInteger( _ swUserPreferenceIntegerValue_e.swUnitSystem, _ swUserPreferenceOption_e.swDetailingNoOptionSpecified) If unitSystem <> swUnitSystem_e.swUnitSystem_IPS Then MsgBox "This macro will only run in IPS(Inch, Pound, Second) Drawing.", vbExclamation, "Add Inch Tick" Exit Sub End If Set swDraw = swModel Set swView = swDraw.GetFirstView Do While Not swView Is Nothing Set swDispDim = swView.GetFirstDisplayDimension5 Do While Not swDispDim Is Nothing Set swDim = swDispDim.GetDimension sCurrSuffix = swDispDim.GetText(swDimensionTextSuffix) If sCurrSuffix <> "" And Not sCurrSuffix = """" Then If MsgBox("Overwrite """ & sCurrSuffix & """?", vbQuestion + vbYesNo) = vbYes Then swDispDim.SetText swDimensionTextSuffix, """" End If Else swDispDim.SetText swDimensionTextSuffix, """" End If Set swDispDim = swDispDim.GetNext3 Loop Set swView = swView.GetNextView Loop swModel.GraphicsRedraw2 MsgBox "Ticks Added to Drawing" End Sub

Well, for the DEBUG CONSOLE, I stumbled on the problem when I wasn't searching. I had a filter active at the top right of the bottom Code Panel. On deleting it, suddenly I saw all the blue reports. Yay!

Filters Instead of creating a dedicated ResultBuffer class like in .NET, I decided to build a wrapper for Python’s built in types. Throughout the API, resbuf* or ResultBuffer are simply a list of tuples, in the format of a group code and a value typedValues = [(TYPE, VALUE)] Depending on the context the group code may be a Lisp type code, or in the case of selection sets, DXF codes. Here are two possible formats # long format filter = [ (Db.DxfCode.kDxfStart, "TEXT,LWPOLYLINE,LINE"), (Db.DxfCode.kDxfOperator, "<OR"), (Db.DxfCode.kDxfLayerName, "0"), (Db.DxfCode.kDxfLayerName, "8"), (Db.DxfCode.kDxfOperator, "OR>"), ] # short format filter = [ (0, "TEXT,LWPOLYLINE,LINE"), (-4, "<OR"), (8, "Layer1"), (8, "Layer2"), (8, "Layer3"), (-4, "OR>"), ]

SelectionSet class methods class SelectionSet: def add(self, id: Db.ObjectId, /) -> None: ... def adsname(self, /) -> Db.AdsName: ... def clear(self, /) -> None: ... def hasMember(self, id: Db.ObjectId, /) -> bool: ... def objectIdArray(self, desc: Rx.RxClass = Db.Entity, /) -> Db.ObjectIdArray: ... def objectIds(self, desc: Rx.RxClass = Db.Entity, /) -> list[Db.ObjectId]: ... def remove(self, id: Db.ObjectId, /) -> None: ... def size(self, /) -> int: ... def ssNameX(self, val: int = 0, /) -> list: ... def ssSetFirst(self, /) -> bool: ... def ssXform(self, xform: Ge.Matrix3d, /) -> Ed.PromptStatus: ... def toList(self, /) -> list[Db.ObjectId]: ... Note, ObjectIdArray is basically the same as list[Db.ObjectId], but the memory is allocated in C++ instead of Python. There may be performance reasons to choose one of the the other, but for now, they can be used interchangeably

Lets say we want only lines and arcs, but still want to use AcDbCurve class, pass a list of descriptions # returns a PromptStatus and a SelectionSet class ps, ss = Ed.Editor.select([(8, "0")]) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) curves = [Db.Curve(id) for id in ss.objectIds([Db.Line.desc(),Db.Arc.desc()])] for curve in curves: print(curve.getDistAtParam(curve.getEndParam()))

Support derived types, Lets say you want to get all the objects in the set that are derived from AcDbCurve, to do some sort of base class operation (AcDb2dPolyline, AcDb3dPolyline, AcDbArc, AcDbCircle, AcDbEllipse, AcDbLeader, AcDbLine, AcDbPolyline, AcDbRay, AcDbSpline, AcDbXline) # returns a PromptStatus and a SelectionSet class ps, ss = Ed.Editor.select([(8, "0")]) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) curves = [Db.Curve(id) for id in ss.objectIds(Db.Curve.desc())] for curve in curves: print(curve.getDistAtParam(curve.getEndParam()))

The real power is post filtering entity types, for example, we want the selection set to filter the visual selection set on screen, but then we want to separate out objects by type. SelectionSet.objectIds() method is overloaded to take an entity class description and returns the types that match. it does not open the object, so it’s extremely fast #returns a PromptStatus and a SelectionSet class ps, ss = Ed.Editor.select([(0, "TEXT,LWPOLYLINE,LINE")]) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) # create a list of entites ant are opened for read texts = [Db.Text(id) for id in ss.objectIds(Db.Text.desc())] lines = [Db.Line(id) for id in ss.objectIds(Db.Line.desc())] plines = [Db.Polyline(id) for id in ss.objectIds(Db.Polyline.desc())] for text in texts: pass # do something for line in lines: pass # do something for pline in plines: pass # do something

The SelectionSet class is an enumerable collection of ObjectIds, example #returns a PromptStatus and a SelectionSet class ps, ss = Ed.Editor.select() for id in ss: ent = Db.Entity(id) print(ent.isA().dxfName())

SelectionSet filters can also be inline Ed.Editor.select([(0, "TEXT,LWPOLYLINE,LINE")])

Entmake text style. (entmake '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "style name here") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 1.0) (3 . "Arial.ttf") (4 . "") ) ) use setvar for dimstyles nothing will be outputted to command prompt. (setvar 'DIMADEC 2) (setvar 'DIMALT "off") I think @Steven P has dug into this more.

Also this as mentioned. (setq ent (entget (car (entsel "\nPick an object for layer name ")))) (setq MyLayerName (cdr (assoc 8 ent))) (setq allPolylines (ssget "_X" (list (0 . "*POLYLINE")(cons 8 MyLayerName))))

The result looks geometrically perfect I also started writing something on Friday with a similar approach. I'll post it when I finish it.

This is kind of close, I split each line into some number of segments, then use closest point. Simplify reduces the number of segments, but changes the precision. Not sure if you can do this in lisp import traceback from pyrx import Db, Ed, Ge, Ap, Rx, Gs @Ap.Command() def centline(): try: ps1, id1, _ = Ed.Editor.entSel("\nPick 1") ps2, id2, _ = Ed.Editor.entSel("\nPick 2") pl1 = Db.Polyline(id1) pl2 = Db.Polyline(id2) crv1 = pl1.getAcGeCurve() crv2 = pl2.getAcGeCurve() #divide into eq segs segs = max(pl1.numVerts(), pl2.numVerts()) * 2 smp1, _ = crv1.getSamplePoints(segs) smp2, _ = crv2.getSamplePoints(segs) spl1 = pl1.getSplitCurves(smp1) spl2 = pl2.getSplitCurves(smp2) pnts = [] pnts.append(pl1.getStartPoint() + (pl2.getStartPoint() - pl1.getStartPoint()) * 0.5) for l, r in zip(spl1, spl2): cl = l.getAcGeCurve() cr = r.getAcGeCurve() poc1, poc2 = cl.getClosestPointsTo(cr) p1 = poc1.point3d() p2 = poc2.point3d() pnts.append(p1 + (p2 - p1) * 0.5) pnts.append(pl1.getEndPoint() + (pl2.getEndPoint() - pl1.getEndPoint()) * 0.5) db = Db.curDb() cs = db.currentSpace(Db.OpenMode.kForWrite) npl = Db.Polyline(pnts) npl.setLayer("0") npl.setColorIndex(3) cs.appendAcDbEntity(npl) except Exception as err: traceback.print_exception(err) drawing AxisExample_dan.dwg

@Tamim Try this code and see if it helpful: (prompt "\nTo run a LISP type: LPL") (princ) (defun c:LPL ( / ss len circ txt_height lst i minPt maxPt midPt circle inc ang num ptlist k pt ssn pl_len ins_pt) (prompt "\nSelect all TEXT entities:\n") (setq ss (ssget (list (cons 0 "TEXT"))) len (sslength ss) circ 0.05 ;; radius of the circle can be changeable txt_height 0.01 ;; mtext height can be changeable lst (list) i 0 ) (while (< i len) (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt) (setq minPt (vlax-safearray->list minPt) maxPt (vlax-safearray->list maxPt) midPt (mapcar '* (mapcar '+ minPt maxPt) (list 0.5 0.5)) ) (entmake (list (cons 0 "CIRCLE") (cons 100 "AcDbEntity") (cons 100 "AcDbCircle") (cons 8 (getvar 'clayer)) (cons 10 midpt) (cons 40 circ))) (setq circle (entlast) inc 0.25 ang 0 num (fix (/ (* pi 2) inc)) ptlist (list) k 0 ) (repeat num (setq pt (polar midPt ang circ) ptlist (append (list pt) ptlist) ang (+ ang inc) ) ) (setq ssn (ssget "_F" ptlist (list (cons 0 "LWPOLYLINE"))) pl_len (getpropertyvalue (ssname ssn k) "Length") ) (entdel circle) (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) "\t " (rtos pl_len 2 3) "\\P") lst) i (1+ i) ) ) (setq lst (vl-sort lst (function (lambda (x e) (< (atoi (substr (car x) 3 (strlen (car x)))) (atoi (substr (car e) 3 (strlen (car e)))))))) lst (cons (list "\\fArial|b0|i0|c0|p34;S.No\tLength Ft\\P") lst) ins_pt (getpoint "\nPick the insertation point:") ) (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 8 (getvar 'clayer)) (cons 10 ins_pt) (cons 40 txt_height) (cons 72 1) (cons 1 (apply 'strcat (mapcar '(lambda (x) (apply 'strcat x)) lst))))) (prompt "\nThe labels and the length of the polylines were added as MTEXT!") (princ) ) Also, you can see the short video example of how it works. LengthPolylineMtext.mp4 Best regards.

No, the program is required to define the reactors used to update the textbox position.

I used a similar approach here, the user wanted to set the elevation of the contour lines to the nearest label. This is where KD-Trees really start to shine as they can handle millions of points, with millions of searches

Yep, easier too, since there would be not need to format the string for MText. Even though Python has robust string operations, it’s still weird to get it perfect https://docs.python.org/3/library/string.html I was just following along the original sample. The part I wanted to illustrate was, using a hashmap for mapping points to objects, and using the KD-Tree to do the spatial search I wrote the same KD-Tree and map for AutoLISP, I’m just really bad at lisp, so it’s hard for me to make samples lol https://github.com/CEXT-Dan/ads_geo

I've disabled some lines of your code that weren't working and added some new lines of code. I hope this helps.

A start with this ? (vl-load-com) (defun make_mlead (pt o r obj / ptlst arr nw_obj) (setq ptlst (append pt (polar pt o r)) arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1))) ) (vlax-safearray-fill arr ptlst) (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0)) (vla-put-contenttype nw_obj acMTextContent) (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;R=" (rtos r 2 2) "\\P\\C1You can put here other value}")) (vla-put-layer nw_obj (getvar "CLAYER")) (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5)) (vla-put-TextHeight nw_obj (getvar "TEXTSIZE")) (if (> (car ptlst) (cadddr ptlst)) (progn (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0))) (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight) (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr)) ) (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft) ) (vla-update nw_obj) ) (defun c:rad2lead ( / ent dxf_ent typ_ent mkv vector vlaobj prm id_rad AcDoc Space ent pt1 pt2 pt x) (while (not (setq ent (entsel "\nSelect a bulge: ")))) (setq typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent)))))) (cond ((or (eq typ_ent "ARC") (eq typ_ent "CIRCLE") (eq typ_ent "LWPOLYLINE") (and (eq typ_ent "POLYLINE") (zerop (boole 1 120 (cdr (assoc 70 dxf_ent)))) ) ) (if (or (> (fix (car (trans (cadr ent) 1 0))) 1E6) (> (fix (cadr (trans (cadr ent) 1 0))) 1E6)) (setq mkv T vector (trans (cadr ent) 0 0 T) vlaobj (vlax-ename->vla-object (car ent))) (setq mkv nil) ) (if mkv (vla-move vlaobj (vlax-3d-point (trans (cadr ent) 1 0)) (vlax-3d-point '(0.0 0.0 0.0)))) (setq id_rad (distance '(0 0) (trans (vlax-curve-getsecondderiv (car ent) (setq prm (vlax-curve-getparamatpoint (car ent) (vlax-curve-getclosestpointto (car ent) (if mkv '(0.0 0.0 0.0) (trans (cadr ent) 1 0))) ) ) ) 0 (car ent) T ) ) ) (if mkv (vla-move vlaobj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point vector))) (cond ((not (zerop id_rad)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (setq ent (car ent)) (if (member typ_ent '("POLYLINE" "LWPOLYLINE")) (setq pt1 (vlax-curve-getPointAtParam ent (fix prm)) pt2 (vlax-curve-getPointAtParam ent (1+ (fix prm))) pt (vlax-curve-getPointAtParam ent (+ (fix prm) 0.5)) ) (setq pt1 (vlax-curve-getStartPoint ent) pt2 (vlax-curve-getEndPoint ent) pt (vlax-curve-getPointAtDist ent (* 0.5 (- (vlax-curve-getDistAtPoint ent pt2) (vlax-curve-getDistAtPoint ent pt1)))) ) ) (setq x (* (fix (/ (angle (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) pt) (* 0.125 pi))) 0.125 pi) x (+ x (rem x (* 0.25 pi))) ) (make_mlead pt x id_rad (vlax-ename->vla-object ent)) (vla-regen AcDoc acactiveviewport) (vla-endundomark AcDoc) ) (T (princ "\nSegment have no bulge.")) ) ) (T (princ "\nThis object can't be availaible for this function!")) ) (prin1) )

@maahee Please upload you sample,dwg . as to test

here's something in Python, if you can find anything in lisp

Select both polylines find the polyline that has the most vertex Then process those vertex with vlax-curve-getClosestPointTo store the mid point of vertex and closest point in a list entmake new polyline with list points. Seems to work well tho will need to test if you have open or closed polylines. defaults to closed tho i don't think its quite the mid / avg path this code isn't quite right see later post. ;;----------------------------------------------------------------------------;; ;; CLOSE POLY AVERAGE, Finds the mid point avg between close polylines donut shape (defun c:CLOSEPOLYAVG (/ sel1 sel2 ent1 ent2 cnt1 cnt2 main other i ptv ptc mid pts) (defun c:CPA () (C:CLOSEPOLYAVG)) (defun midpt (p1 p2) (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2) ) (setq sel1 (entsel "\nSelect First close Polyline: ")) (setq sel2 (entsel "\nSelect Second closed Polyline: ")) (if (and sel1 sel2) (progn (setq ent1 (vlax-ename->vla-object (car sel1)) ent2 (vlax-ename->vla-object (car sel2)) cnt1 (fix (vlax-curve-getEndParam ent1)) cnt2 (fix (vlax-curve-getEndParam ent2)) ) (if (> cnt1 cnt2) (setq main ent1 other ent2) (setq main ent2 other ent1) ) (setq pts '()) (setq i 0) (while (<= i (fix (vlax-curve-getEndParam main))) (setq ptv (vlax-curve-getPointAtParam main i)) (setq ptc (vlax-curve-getClosestPointTo other ptv)) (setq mid (midpt ptv ptc)) (setq pts (append pts (list mid))) (setq i (1+ i)) ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 1) ;; closed ) (mapcar '(lambda (p) (cons 10 p)) pts) ) ) (princ "\nNew midpoint polyline created.") ) (princ "\nSelection error.") ) (princ) )

Long time I'm nothing written in Lisp. So, I hoppe it will serve you. Also, you can saw a short video how it works. The code: (prompt "\nTo run a LISP type: yval") (princ) (defun c:yval ( / old_osmode pline spt ept spt_pline ept_pline datum_line yval_datum_line yval_start_pline yval_end_pline txt_position ang_spt_pline ang_ept_pline datum_value intersecting_lines len i int_pt_pline int_pt_datum_line dist yval_position ang) (setq old_osmode (getvar 'osmode)) (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) (while (or (equal pline nil) (not (equal "LWPOLYLINE" (cdr (assoc 0 (entget pline)))))) (prompt "\nSelected entity must be LWPOLYLINE. Try again...\n") (setq pline (car (entsel "\nSelect Polyline to get an Elevation:"))) ) (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) (if (> (car spt_pline) (car ept_pline)) (progn (command-s "_reverse" pline "") (setq spt_pline (vlax-curve-getStartPoint pline) ept_pline (vlax-curve-getEndPoint pline) ) ) ) (setq datum_line (car (entsel "\nSelect Datum Line:"))) (while (or (equal datum_line nil) (not (equal "LINE" (cdr (assoc 0 (entget datum_line)))))) (prompt "\nSelected entity must be LINE. Try again...\n") (setq datum_line (car (entsel "\nSelect Datum Line:\n"))) ) (setq yval_datum_line (cadr (vlax-curve-getStartPoint datum_line)) yval_start_pline (- (cadr spt_pline) yval_datum_line) yval_end_pline (- (cadr ept_pline) yval_datum_line) ) (setq txt_position (getpoint "\nPick the lower-left corner of the box for elevation value:\n")) (setvar 'osmode 0) (setq datum_value (car (entsel "\nSelect Datum value:"))) (if (equal "MTEXT" (cdr (assoc 0 (entget datum_value)))) (setq datum_value (LM:UnFormat (cdr (assoc 1 (entget datum_value))) T)) (setq datum_value (cdr (assoc 1 (entget datum_value)))) ) (setq ang_spt_pline (angle (setq yval_position_one (list (car spt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) spt_pline) ang_ept_pline (angle (setq yval_position_two (list (car ept_pline) (+ (cadr txt_position) 0.1) (caddr txt_position))) ept_pline) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_start_pline (atof datum_value)) 2 3)) (cons 10 yval_position_one) (cons 11 yval_position_one) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ yval_end_pline (atof datum_value)) 2 3)) (cons 10 yval_position_two) (cons 11 yval_position_two) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_ept_pline))) (princ "\nSelect intersecting lines:") (setq intersecting_lines (ssget (list (cons 0 "LINE") (cons 8 "DATUM-GRID"))) len (sslength intersecting_lines) i 0 ) (while (< i len) (setq int_pt_pline (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object pline) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) int_pt_datum_line (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object datum_line) (vlax-ename->vla-object (ssname intersecting_lines i)) acExtendNone))) dist (distance int_pt_pline int_pt_datum_line) yval_position (list (car int_pt_pline) (+ (cadr txt_position) 0.1) (caddr txt_position)) ang (angle yval_position int_pt_pline) i (1+ i) ) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 1 (rtos (+ dist (atof datum_value)) 2 3)) (cons 10 yval_position) (cons 11 yval_position) (cons 40 0.35) (cons 72 0) (cons 73 2) (cons 50 ang_spt_pline))) ) (setvar 'osmode old_osmode) (prompt "\nAn elevation values were added!") (princ) ) ;;-------------------=={ 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 ) (vl-load-com) (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 ) ) ) ) The short video: YVAL.mp4 Best regards.

Theres no advantage, its the same thing, written in different way. Goal is: to get "out of the box" and writing codes for others in the same way everytime won't do it. Well ofcourse he used getdist instead of getreal, I assume because for user to get the "visual scale". But IMO this approach would be more useful if instead localizing 5 variables, localize 1 assoc list, with 5 associations inside it (atleast I had this idea). EDIT: Like this: _$ (defun PromptUser ( AssocKeys AssocRtns / Lst ) (if (vl-every '(lambda ( key msg / r ) (initget 6) (and (setq r (getdist msg)) (setq Lst (cons (cons key r) Lst)))) AssocKeys AssocRtns ) Lst ) ) PROMPTUSER _$ (setq InputLst (PromptUser '("AR" "CR" "ER" "AO" "TO") '( "\nSpecify approach radius: " "\nSpecify center radius: " "\nSpecify end radius: " "\nSpecify approach offset: " "\nSpecify tie-in offset: " ) ) ) (("TO" . 64.2665) ("AO" . 49.4174) ("ER" . 42.122) ("CR" . 48.0696) ("AR" . 54.2165)) _$ Well I hope atleast Lee get the idea.