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.

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.

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

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.