Leaderboard

Here's a list of most things to draw (line, polyline, circle, ... )

You did a good job. If you add (c:foo) above (princ) at the end rather than (repeat 100 it will repeat until you hit esc. like this (defun c:foo ( / ss ssl get1ss obj gettext ss2 ss2l index enamemleader objmleader ) (princ "\n select original text or mtext") (setq ss (ssget "_+.:E:S" '((0 . "*text")))) (setq ssl (sslength ss)) (setq get1ss (ssname ss (- ssl 1))) (setq obj (vlax-ename->vla-object get1ss)) (setq gettext (vlax-get-property obj 'textstring)) (princ "\n select object multileaders") (setq ss2 (ssget "_+.:E:S" '((0 . "multileader")))) (setq ss2l (sslength ss2)) (setq index 0) (repeat ss2l (setq enamemleader (ssname ss2 index)) (setq objmleader (vlax-ename->vla-object enamemleader)) (vlax-put-property objmleader 'textstring gettext) (setq index (+ index 1)) ) (c:foo) (princ) ); defun and It's better to put your code inside a code form. It is a <> icon at the top of the writing tool.

Yup, know what you mean, we all have our own ways that work for each of us

Using entsel or ssget :E:S is more standard in this case. you are correct it's just my habit. haha I often use ssget to select a window even if when I select only one. because that's personally less likely to make a mistake. (cancel when I select another place, or to not be able to exclude it with shift is more uncomfortable for me)

(defun c:foo ( / ss ssl get1ss obj gettext ss2 ss2l index enamemleader objmleader ) (repeat 100 (princ "\n select original text or mtext") (setq ss (ssget "_+.:E:S" '((0 . "*text")))) (setq ssl (sslength ss)) (setq get1ss (ssname ss (- ssl 1))) (setq obj (vlax-ename->vla-object get1ss)) (setq gettext (vlax-get-property obj 'textstring)) (princ "\n select object multileaders") (setq ss2 (ssget "_+.:E:S" '((0 . "multileader")))) (setq ss2l (sslength ss2)) (setq index 0) (repeat ss2l (setq enamemleader (ssname ss2 index)) (setq objmleader (vlax-ename->vla-object enamemleader)) (vlax-put-property objmleader 'textstring gettext) (setq index (+ index 1)) ) (princ) );repeat ); defun

(defun c:foo ( / ss ssl get1ss obj gettext ss2 ss2l index enamemleader objmleader ) (princ "\n select original text or mtext") (setq ss (ssget '((0 . "*text")))) (setq ssl (sslength ss)) (setq get1ss (ssname ss (- ssl 1))) (setq obj (vlax-ename->vla-object get1ss)) (setq gettext (vlax-get-property obj 'textstring)) (princ "\n select object multileaders") (setq ss2 (ssget '((0 . "multileader")))) (setq ss2l (sslength ss2)) (setq index 0) (repeat ss2l (setq enamemleader (ssname ss2 index)) (setq objmleader (vlax-ename->vla-object enamemleader)) (vlax-put-property objmleader 'textstring gettext) (setq index (+ index 1)) ) (princ) ) you can start with this

3 steps 1 enter string & get the (strlen "abc") = 3 2 insert block with string, hex shape default value 3 use lee-mac (LM:setdynpropvalue blk prp val ) to set property "distance2" The val would be like strlen * Text height. You will need to play a bit with this may need a extra * fuzz. Dynamic Block Functions | Lee Mac Programming (lee-mac.com)

You need to explain more, what it is your trying to do. I have for example update title blocks across multiple layouts. So do you need pick block, pick attributes ? Are you aware this gets a attribute details. (setq att (entget (car (nentsel "\nPick a attribute ")))) (setq att (entget (car (nentsel "\nPick a attribute ")))) ((-1 . <Entity name: 3d5bc970>) (0 . "ATTRIB") (5 . "D999") (330 . <Entity name: 3d5bd070>) (100 . "AcDbEntity") (67 . 1) (410 . "D01") (8 . "DRGTEXT") (62 . 5) (370 . -1) (100 . "AcDbText") (10 693.8875 56.125 0.0) (40 . 7.0) (1 . "PRELIMINARY DRAWING") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "Standard") (71 . 0) (72 . 4) (11 742.1875 59.625 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttribute") (2 . "DRAWING_STATUS") (70 . 0) (73 . 0) (74 . 0) (280 . 0)) 1 is text 2 is tagname

Upper Left = tag text 1 + each number text has 1 number Upper Right = tag text 1 + 1 number text has 2 numbers, get first number and print to prompt Lower Left = tag text 2 case, combine with comma Lower Right = countext2, countext with expression (vl-load-com) (defun c:countext ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ) ) (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (princ "\n in expression = ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (defun c:countext2 ( / tot tagtxt ans texpression ss el en val val2 val2len resulttxt txt pt ) (setq tot 0.0) (setq tagtxt "") (setq ans "") (setq texpression "=") (while (= ans "") (setq ss (ssget ":L" '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq en (ssname ss (setq x (1- x)))) (setq val (cdr (assoc 1 (entget en)))) (setq val2 (LM:parsenumbers val)) (setq val2len (length val2)) (cond ((= val2len 0) (if (= (strlen tagtxt) 0) (setq tagtxt (strcat tagtxt (vl-princ-to-string val))) (setq tagtxt (strcat tagtxt ", " (vl-princ-to-string val))) ) (vla-delete (vlax-ename->vla-object en)) ) ((= val2len 1) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ((> val2len 1) (princ "\n it has 2 numbers, or more. i will select only the first number, please check this list - ") (princ val2) (setq tot (+ tot (car val2))) (if (= (strlen texpression) 1) (setq texpression (strcat texpression (vl-princ-to-string (car val2)))) (setq texpression (strcat texpression "+" (vl-princ-to-string (car val2)))) ) (vla-delete (vlax-ename->vla-object en)) ) ) ) (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (princ "\n in expression ") (princ texpression) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (setq resulttxt (strcat tagtxt " - " txt)) (rh:em_txt pt resulttxt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (rh:em_txt (list (car pt) (- (cadr pt) (* 2 (cdr (assoc 40 el)))) (caddr pt)) texpression (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el)) ) (princ) ) (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun ;; Parse Numbers - Lee Mac ;; Parses a list of numerical values from a supplied string. (defun LM:parsenumbers ( str ) ( (lambda ( l ) (read (strcat "(" (vl-list->string (mapcar '(lambda ( a b c ) (if (or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)) ) b 32 ) ) (cons nil l) l (append (cdr l) '(())) ) ) ")" ) ) ) (vl-string->list str) ) ) how about this countext - only result countext2 - with expression

Hi all, Here's a routine that I wrote to get areas in m² via drawing them or picking inside areas (It works for only decimal units). It allows the user to draw temporary lines to close up any large gaps and choose a gap tolerance. And then modifies existing TEXT or MTEXT or creates new MTEXT based on the chosen options. I believe it's still a WIP but I'd be happy to hear your well constructed critique on it. More notes on what it does in the header but GIF below of basic usage. ;; Quick loader for the routine. (defun c:--LDArea_Get_Mod_Or_New_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (c:Area_Get_Mod_Or_New_Text))) ;; ;; Area_Get_Mod_Or_New_Text by 3dwannab ;; It's a WIP of sorts. ;; ;; First written on the 2022.01.22 ;; Last modified on the 2022.02.03 ;; ;; WHAT IS DOES: ;; 1. Asks the user if they want to modify existing TEXT or MTEXT or create ;; new MTEXT. ;; 2. Asks the user if they want to pick and area to draw an area to get. ;; 3. If they choose to modify existing TEXT or MTEXT then this programs will ;; First create a layer state to restore that after and hide layers that ;; contain things like, fur, dim, kitchen or hatch. ;; 4. If the pick option was chosen then it will then ask to draw temporary ;; lines to close up any large gaps. ;; 5. If the pick option was chosen, it asks the user for a gap tolerance. If no ;; gaps are leading to the other model space then this doesn't need any ;; value. ;; 6. If the pick option was chosen, you're asked to pick an internal point ;; inside the area that you have closed with the temporary lines if ;; applicable. ;; 7. Depending on whether you wanted to replace existing TEXT or MTEXT it will ;; either modify the existing TEXT or MTEXT or ask you to pick a point for ;; the new MTEXT which is MC (Middle Center) justified. ;; 8. And lastly, lastly it'll remove the temporary lines or hatches you had ;; created throughout the process. ;; ;; TO DO: ;; Nothing at the time of writing :) ;; ;; NOTES: ;; - The units used must be decimal. ;; - Hides all layers, then unhides wall, window and annotation layers. Change ;; this to suit your needs below in the code. ;; - Rounds off the area to 2 decimal places. ;; - The text must have the contents of either: 4.00m2 or 4.00m² to replace it ;; with. ;; - And this can also have other text in there but this program will only ;; replace either of the 2 types of string above as the match is done using a ;; regular expression. ;; (defun c:Area_Get_Mod_Or_New_Text ( / acDoc *error* acDoc ansDrawOrPick ansNewOrExisting areacmdstr areainmmval ent gaptolerance gaptoleranceDefault i loopForDrawLines loopForPickHatch mtextcontents MyPoint ptHatch ptNewText regexp_oldstr result ssHatches ssHide ssLines ssText ssTextAll stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (vl-load-com) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) ;; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ;;; Unhides the selection set (if ssHide (acet-ss-visible ssHide 0)) ;; Restore the layer states and delete it (layerstate-restore stateName nil nil) (if (layerstate-has stateName) (progn (layerstate-delete stateName nil nil) ;; (layerstate-save stateName nil nil) ) ) (princ "\nExiting '3dwannab_Area_Get.lsp' Program\n")(princ) (setvar 'cmdecho var_cmdecho) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) (setvar 'hpislanddetectionmode var_hpislanddetectionmode) (setvar 'hpname var_hpname) (setvar 'hpquickpreview var_hpquickpreview) (setvar 'hptransparency var_hptransparency) (setvar 'nomutt var_nomutt) (setvar 'osmode var_hpseparate) (setvar 'osmode var_osmode) (princ) ) ;; Sets the variables (setq var_cmdecho (getvar "cmdecho")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpislanddetectionmode (getvar "hpislanddetectionmode")) (setq var_hpname (getvar "hpname")) (setq var_hpquickpreview (getvar "hpquickpreview")) (setq var_hpseparate (getvar "hpseparate")) (setq var_hptransparency (getvar "hptransparency")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) ;; Set the ACAD variables that need setting for the program ;; Here's a list of variables relating to hatching: https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2021/ENU/AutoCAD-Core/files/GUID-B94870E7-49CE-4BB0-A978-382A38E1FED8-htm.html (setq stateName "3dwannab_Area_Get") (setvar 'cmdecho 0) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'hpislanddetectionmode 1) ; Important that this is set to 1. Controls whether islands within new hatches and fills are detected in this session. 0 Off. 1 On (recommended). Hatches or ignores islands according to HPISLANDDETECTION. (setvar 'hpname "SOLID") ; This must be a string. (setvar 'hpquickpreview 1) ; This is either 0 for off or 1 for on. Test this in the off state. (setvar 'hpseparate 0) ; Important that this is set to 0 for joining the hatches as one. Controls whether a single hatch object or separate hatch objects are created when operating on several closed boundaries. (setvar 'hptransparency "22") ; This must be a string. (progn ;; Start the undo mark here (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) ;; initget from LeeMac help pages ;; Prompt the user to Modify the existing or create new text (initget "Modify New") (setq ansNewOrExisting (cond ( (getkword (strcat "\nModify existing text or create new MTEXT ?[Modify/New] <" (setq ansNewOrExisting (cond ( ansNewOrExisting ) ( "Modify" )) ) ">: " ) ) ) ( ansNewOrExisting ) ) ) ;; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ;; Based on the answer at the beginning setup the Modify variables (cond ((= "Modify" ansNewOrExisting) (progn ;; First select the TEXT and/or MTEXT that needs to get updated (Can be ;; multiple selection) ;; This will allow hidding of all other text objects using the: ;; (acet-ss-visible ss1 1) ; Hide ss1 ;; (acet-ss-visible ss1 0) ; Un-hide ss1 (terpri)(prompt "Select any TEXT or MTEXT you want to update :")(terpri) (setvar 'nomutt 1) ; Setting the numutt variable to 1 allows the prompt to show up. See: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-with-custom-prompt/m-p/1735374#M219362 ;; (setq ssText (ssget '((0 . "MTEXT,TEXT")))) (setq ssText (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) (if ssText (progn ;; Get all the text in the drawing space and put it to a selection for hiding. (setq ssTextAll (ssget "_X" '((0 . "*TEXT,LEADER,MULTILEADER,DIMENSION")))) (setq ssHide (3d:RemoveSSFromSS ssText ssTextAll)) ) ) ;; Another option here to do the same as my 3d:RemoveSSFromSS function above. ;; See: https://www.cadtutor.net/forum/topic/74425-remove-selection-set-from-another-retain-the-first-selection-set/?do=findComment&comment=589247 ;; (setq ssHide ;; (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssText))) ;; (ssdel ent ssTextAll) ;only removes the entity from the selection set doesn't delete the entity from the drawing. ;; ) ;; ) (acet-ss-visible ssHide 1) ; Hides ssHide ;; If the ssText selection set is empty exit the program (if (= ssText nil) (exit)) ) ) ;; No condition needed for new text here ) ;; initget from LeeMac help pages ;; Prompt the user to Modify the existing or create new text (initget "Pick Draw") (setq ansDrawOrPick (cond ( (getkword (strcat "\nPick or draw the area to get ?[Pick/Draw] <" (setq ansDrawOrPick (cond ( ansDrawOrPick ) ( "Pick" )) ) ">: " ) ) ) ( ansDrawOrPick ) ) ) ;; Hides all layers. (command "._layer" "_OFF" "*" "" "") ;; Turn on the layers that you want to here. (command "._layer" "_ON" "*wall*" "") (command "._layer" "_ON" "*boundary*" "") (command "._layer" "_ON" "*area*" "") (command "._layer" "_ON" "*window*" "") (command "._layer" "_ON" "0" "") (command "._layer" "_ON" "*AN*" "") ;; Based on the answer for drawing or picking an area do these conditions (cond ((= "Draw" ansDrawOrPick) ;; Enter the area command (command-s "area" pause "" "") ) ((= "Pick" ansDrawOrPick) (progn ;; While loop to draw temporary lines using initget ;; Based off LeeMacs code here: https://www.cadtutor.net/forum/topic/70799-how-to-continuously-run-a-condition/#comment-568357 (setvar 'osmode 3) ; Set snaps to what you want (setq ssLines (ssadd)) ; Create empty selection set (setq loopForDrawLines "loop") ; Marker to whether to loop again or end the loop (while (= "loop" loopForDrawLines ) ; Loop if loop marker says 'loop' (progn (setq MyPoint (getpoint "\nDraw gap filling lines? (Press SPACE or ENTER to skip this step) : ")) ) (if (= MyPoint nil) (setq loopForDrawLines "StopLoop") ; If no point is selected (enter or space pressed) (progn ; Else do this loop (Command "._Line" MyPoint pause "") (setq MyPoint nil) ; Might not be needed, but why not have this (setq ssLines (ssadd (entlast) ssLines)) ; Add line to selection set (as item 0, the previous line is line 1, etc) ) ) ) ; End while ;; Only turn off osmode after drawing the lines. (setvar 'osmode 0) ;; Get hpgaptol variable and set it to the entered amount (setq gaptoleranceDefault (getvar "hpgaptol")) ;; Prompt for distance, if nil use default (setq gaptolerance (cond ((getdist (strcat "\nPick or enter the gap tolerance for the hatched area :\nCurrent value <" (vl-princ-to-string (getvar "hpgaptol")) ">: "))) (gaptoleranceDefault) ) ) (setvar "hpgaptol" gaptolerance) ;; Click the internal area for the hatching ;; (command "_.bhatch") ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatching-by-lisp/m-p/5923832/highlight/true#M336978 ;; Loop the hatch command until the user exits or returns out it (setq ssHatches (ssadd)) ; Create empty selection set (setq loopForPickHatch "loop") ; Marker to whether to loop again or end the loop (while (= "loop" loopForPickHatch ) ; Loop if loop marker says 'loop' (progn (setq ptHatch (getpoint "\nPick an area to hatch (Press ESC cancel) : ")) ) (if (/= ptHatch nil) (progn ; Do this loop (command "._bhatch" ptHatch) (while (> (getvar 'cmdactive) 0) (progn (command pause) (setq ssHatches (ssadd (entlast) ssHatches)) ) ) (setq loopForPickHatch "StopLoop") ; If no point is selected (enter or space pressed) (setq ptHatch nil) ; Might not be needed, but why not have this (setq ssHatches (ssadd (entlast) ssHatches)) ; Add hatch to selection set ) ) ) ; End while loopForPickHatch ;; Old method for picking the hatch, this step could get skipped when ;; enter, right-click or space bar was used. ;; (setq ssHatches (ssadd)) ; creates a blank selection set ;; (while (> (getvar 'cmdactive) 0) ;; (progn ;; (command pause) ;; (setq ssHatches (ssadd (entlast) ssHatches)) ;; ) ;; ) ; while end ;; Here it checks the lastprompt variable and if it finds: ;; Valid hatch boundary not found. ;; Then the program will exit. ;; (while (> (getvar 'cmdactive) 0) (if (wcmatch (strcase (getvar 'lastprompt)) "*HATCH BOUNDARY NOT*") (progn (ACET-UI-MESSAGE "Valid hatch boundary not found. " "Exiting Program" (+ Acet:OK Acet:ICONWARNING) ) (setq ssLines nil) ; This will set the selection set to nil (setq ssHatches nil) ; This will set the selection set to nil (exit) ) ) ;; Use the area command to get the last value and convert it to m² ;; Only do this for the picking. The (getvar "area") below will do it for the drawn area (command "._area" "_O" "_L") ) ) ) (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (setq mtextcontents (strcat areainmmval "m\U+00B2")) (terpri)(princ (strcat areacmdstr))(terpri) (cond ;; Modify the MTEXT based on the answer at the beginning ((= "Modify" ansNewOrExisting) ;; Modify the selected TEXT and/or MTEXT with the area in meters squared (if ssText (progn (repeat (setq i (sslength ssText)) (setq ent (entget (ssname ssText (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regexp_oldstr "\\d+\\.?\\d*m[²|2]") (setq result (SS_RegExp str regexp_oldstr mtextcontents )) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; End progn ) ; End if ssText ) ;; Create the MTEXT at the picked point based on the answer at the beginning ((= "New" ansNewOrExisting) (progn (princ (strcat areacmdstr)) ;; Click the internal area for the hatching (graphscr) (setq ptNewText (getpoint "\nClick position for new text point : "))(terpri) (command "._MTEXT" ptNewText "_J" "_TC" "_C" "_N" "_H" pause ptNewText mtextcontents "") ) ) ) ) (vla-EndUndoMark acDoc) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- ;; 3dwannab ;; Removes a selection set from another. And also removes any of the same ;; entities. ;; Returns ssKeep selection set. ;; Wrote on 2022.01.31 ;; Usage: ;; (3d:RemoveSSFromSS ssKeep ssRemove) (defun 3d:RemoveSSFromSS ( ssKeep ssRemove / i ent ssNew ) (setq ssNew (ssadd)) (repeat (setq i (sslength ssRemove)) (setq ent (ssname ssRemove (setq i (1- i)))) (if (not (ssmemb ent ssKeep)) (setq ssNew (ssadd ent ssNew)) ) ) ssNew ) (defun SS_RegExp ( strOld findPattern strReplace / reObj result ) (vl-load-com) (setq reObj (vlax-create-object "Vbscript.RegExp")) (vlax-put-property reObj "IgnoreCase" 1) (vlax-put-property reObj "Global" 1) (vlax-put-property reObj "Pattern" findPattern ) (setq result (vlax-invoke-method reObj "Replace" strOld strReplace) ) result ) (princ (strcat "\n3dwannab_Area_Get.lsp edited on " (menucmd "m=$(edtime,0,DD-MO-yyyy)") " by 3dwannab (stephensherry147@yahoo.co.uk) loaded" "\nType \"Area_Get_Mod_Or_New_Text\" to run Program" ) ) (princ)

Updated to draw a regular rectangle. ;; Quick loader for the routine. (defun c:--LDAreas_Get_Mod_Or_New_Text ( / ) (progn (LOAD "3dwannab_Areas_Get") (c:Areas_Get_Mod_Or_New_Text))) ;; ;; Areas_Get_Mod_Or_New_Text by 3dwannab ;; It's a WIP of sorts. ;; ;; First written on the 2022.01.22 ;; Last modified on the 2022.07.04 ;; ;; WHAT IS DOES: ;; 1. Asks the user if they want to modify existing TEXT or MTEXT or create new ;; MTEXT. ;; 2. Asks the user if they want to pick an area, draw a rectangle, draw an area ;; to get or select any of the following objects: Arc, Circle, Ellipse, Hatch ;; or Polyline to get the area of. ;; 3. If they choose to modify existing TEXT or MTEXT then this programs will ;; First create a layer state to restore that after and hide layers that ;; contain things like, fur, dim, kitchen or hatch. ;; 4. If the pick option was chosen then it will then ask to draw temporary ;; lines to close up any large gaps. ;; 5. If the pick option was chosen, it asks the user for a gap tolerance. If no ;; gaps are leading to the other model space then this doesn't need any ;; value. ;; 6. If the pick option was chosen, you're asked to pick an internal point ;; inside the area that you have closed with the temporary lines if ;; applicable. ;; 7. Depending on whether you wanted to replace existing TEXT or MTEXT it will ;; either modify the existing TEXT or MTEXT or ask you to pick a point for ;; the new MTEXT which is MC (Middle Center) justified. ;; 8. You will get prompted for the decimal round off value at the end which ;; where the value will get saved to the registry so it'll get remembered ;; even after closing AutoCAD. ;; 0 will result in an area: 4m² ;; 2 will result in an area: 4.44m² ;; 3 will result in an area: 4.443m² ;; 9. And lastly, lastly it'll remove the temporary lines or hatches you had ;; created throughout the process. ;; ;; TO DO: ;; Nothing at the time of writing :) ;; ;; NOTES: ;; - The units used must be decimal. ;; - Hides all layers, then unhides wall, window and annotation layers. Change ;; this to suit your needs below in the code. ;; - Rounds off the area to 2 decimal places. ;; - The text must have the contents of either: 4.00m2 or 4.00m² to replace it ;; with. ;; - And this can also have other text in there but this program will only ;; replace either of the 2 types of string above as the match is done using a ;; regular expression. ;; (defun c:Areas_Get_Mod_Or_New_Text ( / acDoc *error* ansDrawPickSelectHatch ansNewOrExisting areacmdstr areaHatchSel areainmmval commandFinished ent eo gaptolerance gaptoleranceDefault i loopForDrawLines loopForPickHatch lst mtextcontents MyPoint newPolyline pt ptHatch ptNewText regexp_oldstr regValDecimalPlaces result ssHatches ssHatchesExisting ssHide ssLines ssText ssTextAll stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (vl-load-com) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (vla-StartUndoMark (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) ;; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ;;; Unhides the selection set (if ssHide (acet-ss-visible ssHide 0)) ;; Restore the layer states and delete it (layerstate-restore stateName nil nil) (if (layerstate-has stateName) (progn (layerstate-delete stateName nil nil) ;; (layerstate-save stateName nil nil) ) ) (princ "\nExiting '3dwannab_Areas_Get.lsp' Program\n")(princ) (setvar 'cmdecho var_cmdecho) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) (setvar 'hpislanddetectionmode var_hpislanddetectionmode) (setvar 'hpname var_hpname) (setvar 'hpquickpreview var_hpquickpreview) (setvar 'hptransparency var_hptransparency) (setvar 'nomutt var_nomutt) (setvar 'osmode var_hpseparate) (setvar 'osmode var_osmode) (princ) ) ;; Sets the variables (setq var_cmdecho (getvar "cmdecho")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpislanddetectionmode (getvar "hpislanddetectionmode")) (setq var_hpname (getvar "hpname")) (setq var_hpquickpreview (getvar "hpquickpreview")) (setq var_hpseparate (getvar "hpseparate")) (setq var_hptransparency (getvar "hptransparency")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) ;; Set the ACAD variables that need setting for the program ;; Here's a list of variables relating to hatching: https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2021/ENU/AutoCAD-Core/files/GUID-B94870E7-49CE-4BB0-A978-382A38E1FED8-htm.html (setq stateName "3dwannab_Areas_Get") (setvar 'cmdecho 0) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'hpislanddetectionmode 1) ; Important that this is set to 1. Controls whether islands within new hatches and fills are detected in this session. 0 Off. 1 On (recommended). Hatches or ignores islands according to HPISLANDDETECTION. (setvar 'hpname "SOLID") ; This must be a string. (setvar 'hpquickpreview 1) ; This is either 0 for off or 1 for on. Test this in the off state. (setvar 'hpseparate 0) ; Important that this is set to 0 for joining the hatches as one. Controls whether a single hatch object or separate hatch objects are created when operating on several closed boundaries. (setvar 'hptransparency "22") ; This must be a string. (progn ;; Start the undo mark here (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) ;; initget from LeeMac help pages ;; Prompt the user to Modify the existing or create new text (initget "Modify New") (setq ansNewOrExisting (cond ( (getkword (strcat "\nModify existing text or create new MTEXT ?[Modify/New] <" (setq ansNewOrExisting (cond ( ansNewOrExisting ) ( "Modify" )) ) ">: " ) ) ) ( ansNewOrExisting ) ) ) ;; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ;; Based on the answer at the beginning setup the Modify variables (cond ((= "Modify" ansNewOrExisting) (progn ;; First select the TEXT and/or MTEXT that needs to get updated (Can be ;; multiple selection) ;; This will allow hidding of all other text objects using the: ;; (acet-ss-visible ss1 1) ; Hide ss1 ;; (acet-ss-visible ss1 0) ; Un-hide ss1 (terpri)(prompt "Select any TEXT or MTEXT you want to update :")(terpri) (setvar 'nomutt 1) ; Setting the numutt variable to 1 allows the prompt to show up. See: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-with-custom-prompt/m-p/1735374#M219362 ;; (setq ssText (ssget '((0 . "MTEXT,TEXT")))) (setq ssText (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) (if ssText (progn ;; Get all the text in the drawing space and put it to a selection for hiding. (setq ssTextAll (ssget "_X" '((0 . "*TEXT,LEADER,MULTILEADER,DIMENSION")))) (setq ssHide (3d_RemoveSSFromSS ssText ssTextAll)) ; Remove the first selection set from the second ) ) (acet-ss-visible ssHide 1) ; Hides ssHide ;; If the ssText selection set is empty exit the program (if (= ssText nil) (exit)) ) ) ;; No condition needed for new text here ) (initget "Pick Draw drawRectangle Select") (setq ansDrawPickSelectHatch (cond ( (getkword (strcat "\nPick, Draw or Select object to get the area of ?[Pick/Draw/draw Rectangle/Select] <" (setq ansDrawPickSelectHatch (cond ( ansDrawPickSelectHatch ) ( "Pick" )) ) ">: " ) ) ) ( ansDrawPickSelectHatch ) ) ) ;; Hides all layers. (command "._layer" "_OFF" "*" "" "") ;; Turn on the layers that you want to here. (command "._layer" "_ON" "*wall*" "") (command "._layer" "_ON" "*boundary*" "") (command "._layer" "_ON" "*area*" "") (command "._layer" "_ON" "*kitchen*" "") (command "._layer" "_ON" "*window*" "") (command "._layer" "_ON" "0" "") (command "._layer" "_ON" "*AN*" "") (command "._layer" "_ON" "*ST*" "") (command "._layer" "_ON" "*no*plot*" "") (command "._layer" "_ON" "*WC*" "") (command "._layer" "_ON" "*WS*" "") ;; Based on the answer for drawing or picking an area do these conditions (cond ((= "drawRectangle" ansDrawPickSelectHatch) ;; Enter the rectangle command and get its area ;; Delete the rectangle once finish. ;; Required function from Lee Mac to return the last subentity in the ;; database ;; This will prevent this section from deleting other objects if the ;; rectangle command is cancelled. (progn (setq ent (LM:entlast)) (command-s "._rectang") (while (< 0 (getvar 'cmdactive)) (command "\\")) (while (setq ent (entnext ent)) (command-s "area" "_O" "_L" "") (entdel ent) ) (setq commandFinished T) ) ) ;; End Draw Rectangle ((= "Draw" ansDrawPickSelectHatch) ;; Enter the area command ;; This will ask for multiple areas. Just return twice to finish (progn (command-s "area" "_A" pause "") (setq commandFinished T) ) ) ((= "Select" ansDrawPickSelectHatch) ;; Get the area of the selected objects (progn (setq areaHatchSel 0 i 0 ) ;; Get any objects here that are pre selected ;; (sssetfirst nil (ssget "_P")) (princ "\nSelect any Arc, Circle, Ellipse, Hatch or Polyline") (setq ssHatchesExisting (ssget "_:L" '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE")))) (cond ((and(and ssHatchesExisting) (> (sslength ssHatchesExisting) 0)) (repeat (sslength ssHatchesExisting) (setq eo (vlax-ename->vla-object (ssname ssHatchesExisting i))) (setq areaHatchSel (+ areaHatchSel (vlax-get eo 'Area))) (setq i (+ i 1)) ) ) ) ; End cond (setq commandFinished T) ) ; End progn ) ((= "Pick" ansDrawPickSelectHatch) (progn ;; While loop to draw temporary lines using initget ;; Based off LeeMacs code here: https://www.cadtutor.net/forum/topic/70799-how-to-continuously-run-a-condition/#comment-568357 (setvar 'osmode 3) ; Set snaps to what you want (setq ssLines (ssadd)) ; Create empty selection set (setq loopForDrawLines "loop") ; Marker to whether to loop again or end the loop (while (= "loop" loopForDrawLines ) ; Loop if loop marker says 'loop' (progn (setq MyPoint (getpoint "\nDraw gap filling lines? (Press SPACE or ENTER to skip this step) : ")) ) (if (= MyPoint nil) (setq loopForDrawLines "StopLoop") ; If no point is selected (enter or space pressed) (progn ; Else do this loop (Command "._Line" MyPoint pause "") (setq MyPoint nil) ; Might not be needed, but why not have this (setq ssLines (ssadd (entlast) ssLines)) ; Add line to selection set (as item 0, the previous line is line 1, etc) ) ) ) ; End while ;; Only turn off osmode after drawing the lines. (setvar 'osmode 0) ;; Get hpgaptol variable and set it to the entered amount (setq gaptoleranceDefault (getvar "hpgaptol")) ;; Prompt for distance, if nil use default (setq gaptolerance (cond ((getdist (strcat "\nPick or enter the gap tolerance for the hatched area :\nCurrent value <" (vl-princ-to-string (getvar "hpgaptol")) ">: "))) (gaptoleranceDefault) ) ) (setvar "hpgaptol" gaptolerance) ;; Click the internal area for the hatching ;; (command "_.bhatch") ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatching-by-lisp/m-p/5923832/highlight/true#M336978 ;; Loop the hatch command until the user exits or returns out it (setq ssHatches (ssadd)) ; Create empty selection set (setq loopForPickHatch "loop") ; Marker to whether to loop again or end the loop (while (= "loop" loopForPickHatch ) ; Loop if loop marker says 'loop' (progn (setq ptHatch (getpoint "\nPick an area to hatch (Press ESC cancel) : ")) ) (if (/= ptHatch nil) (progn ; Do this loop (command "._bhatch" ptHatch) (while (> (getvar 'cmdactive) 0) (progn (command pause) (setq ssHatches (ssadd (entlast) ssHatches)) ) ) (setq loopForPickHatch "StopLoop") ; If no point is selected (enter or space pressed) (setq ptHatch nil) ; Might not be needed, but why not have this (setq ssHatches (ssadd (entlast) ssHatches)) ; Add hatch to selection set ) ) ) ; End while loopForPickHatch ;; Old method for picking the hatch, this step could get skipped when ;; enter, right-click or space bar was used. ;; (setq ssHatches (ssadd)) ; creates a blank selection set ;; (while (> (getvar 'cmdactive) 0) ;; (progn ;; (command pause) ;; (setq ssHatches (ssadd (entlast) ssHatches)) ;; ) ;; ) ; while end ;; Here it checks the lastprompt variable and if it finds: ;; Valid hatch boundary not found. ;; Then the program will exit. ;; (while (> (getvar 'cmdactive) 0) (if (wcmatch (strcase (getvar 'lastprompt)) "*HATCH BOUNDARY NOT*") (progn (ACET-UI-MESSAGE "Valid hatch boundary not found. " "Exiting Program" (+ Acet:OK Acet:ICONWARNING) ) (setq ssLines nil) ; This will set the selection set to nil (setq ssHatches nil) ; This will set the selection set to nil (exit) ) ) ;; Use the area command to get the last value and convert it to m² ;; Only do this for the picking. The (getvar "area") below will do it for the drawn area (command "._area" "_O" "_L") (setq commandFinished T) ) ) ) ;; IMPORTANT ;; First, exit the program if the commandFinished is not T. (if (not commandFinished) (exit) ) ;; Get saved round off value from the registry or default to 1 (setq regValDecimalPlaces (cond ((getenv "Area_Get_Decimal_Places")) (1))) ;; Prompt for integer value to round off to (setq regValDecimalPlaces (cond ((getint (strcat "\nEnter the decimal places you want to round off to :\nCurrent value <" (vl-princ-to-string regValDecimalPlaces) ">: "))) (regValDecimalPlaces) ) ) ;; Set the registry value to the variable (setenv "Area_Get_Decimal_Places" (vl-princ-to-string regValDecimalPlaces)) ;; This if statement is for when objects are selected or if the area is ;; retrieved via the area command. (if areaHatchSel (setq areainmmval (rtos (/ areaHatchSel 1e6) 2 (read (getenv "Area_Get_Decimal_Places")))) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 (read (getenv "Area_Get_Decimal_Places")))) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 ) (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (setq mtextcontents (strcat areainmmval "m\U+00B2")) (terpri)(princ (strcat areacmdstr))(terpri) (cond ;; Modify the MTEXT based on the answer at the beginning ((= "Modify" ansNewOrExisting) ;; Modify the selected TEXT and/or MTEXT with the area in meters squared (if ssText (progn (repeat (setq i (sslength ssText)) (setq ent (entget (ssname ssText (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regexp_oldstr "\\d+\\.?\\d*\\s*m[²|2]") (setq result (3d_RegExp str regexp_oldstr mtextcontents )) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; End progn ) ; End if ssText ) ;; Create the MTEXT at the picked point based on the answer at the beginning ((= "New" ansNewOrExisting) (progn (princ (strcat areacmdstr)) ;; Click the internal area for the hatching (graphscr) (initget 1) ; Prevents using enter, therefore the point is required. Escape to cancel is the only option. (setq ptNewText (getpoint "\nClick position for new text point : ")) (if ptNewText (command "._MTEXT" ptNewText "_J" "_TC" "_C" "_N" "_H" pause ptNewText mtextcontents "") ) ) ) ) ) (vla-EndUndoMark acDoc) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- ;; entlast - Lee Mac ;; A wrapper for the entlast function to return the last subentity in the database (defun LM:entlast ( / ent tmp ) (setq ent (entlast)) (while (setq tmp (entnext ent)) (setq ent tmp)) ent ) ;; 3dwannab ;; Removes a selection set from another. And also removes any of the same ;; entities. ;; Returns ssKeep selection set. ;; Wrote on 2022.01.31 ;; Usage: ;; (3d_RemoveSSFromSS ssKeep ssRemove) (defun 3d_RemoveSSFromSS ( ssKeep ssRemove / i ent ssNew ) (setq ssNew (ssadd)) (repeat (setq i (sslength ssRemove)) (setq ent (ssname ssRemove (setq i (1- i)))) (if (not (ssmemb ent ssKeep)) (setq ssNew (ssadd ent ssNew)) ) ) ssNew ) (defun 3d_RegExp ( strOld findPattern strReplace / reObj result ) (vl-load-com) (setq reObj (vlax-create-object "Vbscript.RegExp")) (vlax-put-property reObj "IgnoreCase" 1) (vlax-put-property reObj "Global" 1) (vlax-put-property reObj "Pattern" findPattern ) (setq result (vlax-invoke-method reObj "Replace" strOld strReplace) ) result ) (princ (strcat "\n3dwannab_Area_Get.lsp edited on " (menucmd "m=$(edtime,0,DD-MO-yyyy)") " by 3dwannab (stephensherry147@yahoo.co.uk) loaded" "\nType \"Areas_Get_Mod_Or_New_Text\" to run Program" ) ) (princ) ;; (c:Areas_Get_Mod_Or_New_Text)

Calteq you can get strlen which is number of characters in a string so could do a fuzz * strlen to work out "distance2" then use lee-mac dynamic properties .lsp to set value.

Hi G A simple solution is to use a dynamic block as attached Adjust to suit text sizes and your preferences. HexLeader.dwg

for got to comment on this but always use "_non" in front of points in command. (command "_.Pline" "_non" pt3 "_non" pt2 "_non" pt1 "") just know if any of those points where close to geometry even if osnaps are off (f3 toggle) it could still snap to things that where close. the "_non" tells the command pline snap to this point only nothing else

will now only update the dimensions selected. will now ask for precision of decimal places with a default of [3] will now create a text above the dimension of the old fractional dimension red in color with the correct offset and angle (defun C:DIM-Convert (/ ss dim obj old dist off hgt pt) (or (setq x (getint "\nSet Dimension Precision [3]")) (setq x 3)) ;3 change to defualt percision you want (if (setq ss (ssget '((0 . "DIMENSION")))) (foreach dim (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq obj (vlax-ename->vla-object dim)) (if (eq (setq old (vlax-get obj 'TextOverride)) "") (progn) (progn (setq dist (distof old)) (vla-put-textoverride obj (rtos dist 2 x)) ;you can just hard code precision here by changing the x to # or decimal places (vla-put-textsuffix obj old) ;store old overide (setq off (* (setq hgt (vlax-get obj 'TextHeight)) 1.5)) (setq pt (vlax-get obj 'TextPosition)) (setq pt (polar pt (+ (setq ang (vla-get-textrotation obj)) (/ pi 2)) off)) (entmake (list '(0 . "TEXT")(cons 10 pt)(cons 11 pt)(cons 40 hgt)(cons 50 ang)'(62 . 1)(cons 1 old)'(072 . 4))) ) ) ) ) (princ) )

It also looks like Mpolygon's act kind of like a block in a way that the cords gathered from _mpolycoord are relative to the mpolygon not the UCS. I also dumped a mpolygon and found this. .... (93 . 8) (10 3.0700752477369 0.241102250925906 0.0) (10 3.21999436359511 2.22349846711586 0.0) (10 2.8649983635969 2.73649046710489 0.0) (10 0.406000363595012 2.94049046710279 0.0) (10 0.336118351855475 0.710920098215865 0.0) (10 -2.97433618887044 0.948314370230946 0.0) (10 -3.21999436359511 -2.47737999489618 0.0) (10 2.8294666532438 -2.94049046710279 0.0) (76 . 1) (63 . 256) (11 1411.34299715093 -359.973837993358 0.0) (99 . 0) ... You have to add point 11 to all the other point 10's to get the real location. (defun C:test (/ ent off cord cords coords) (setq ent (entget (car (entsel)))) (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (or (eq (car x) '10)(eq (car x) '11))) (member '(210 0.0 0.0 1.0) ent)))) (setq off (car (reverse cords))) ;set off to point 11 (setq cords (vl-remove off cords)) ;remove point 11 from list (foreach cord cords (setq coords (cons (mapcar '+ cord off) coords)) ;get correct coords by adding the offset to each point. ) ) so instead of getting a point list of ((3.0700752477369 0.241102250925906 0.0) (3.21999436359511 2.22349846711586 0.0) ...) You get the correct point list of ((1414.17246380417 -362.914328460461 0.0) (1408.12300278733 -362.451217988254 0.0) ...)

Sure Trevor, try this: (defun c:ptlab (/ Text _PromptWithDefault _Cross Pt pos) ;; Lee Mac ~ 30.03.10 (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 7 (getvar 'TEXTSTYLE)) (cons 1 str)))) (defun _PromptWithDefault (f arg d) (cond ((apply f arg)) (d))) (defun _Cross (p h / l) (setq l (sqrt (* 0.5 h h))) (mapcar (function (lambda (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))) (list (polar p (/ pi 4.) l) (polar p (/ (* 3 pi) 4.) l)) (list (polar p (/ (* 5 pi) 4.) l) (polar p (/ (* 7 pi) 4.) l)))) (setq *Coord* (cond (*Coord*) ("Y")) *tHgt* (cond (*tHgt* ) ((getvar 'TEXTSIZE))) *thOff* (cond (*thOff*) (1.0)) *tvOff* (cond (*tvOff*) (1.0)) *cSze* (cond (*cSze* ) ((getvar 'TEXTSIZE)))) (setq pos '(("X" . 0) ("Y" . 1) ("Z" . 2))) (initget "X Y Z") (mapcar (function set) '(*Coord* *tHgt* *thOff* *tvOff* *cSze*) (mapcar (function _PromptWithDefault) '(getkword getdist getdist getdist getdist ) (list (list (strcat "\nSpecify Coord to Label [X/Y/Z] <" *Coord* "> : ")) (list (strcat "\nSpecify Text Height <" (rtos *tHgt*) "> : ")) (list (strcat "\nSpecify Horizontal Text Offset <" (rtos *thOff*) "> : ")) (list (strcat "\nSpecify Vertical Text Offset <" (rtos *tvOff*) "> : ")) (list (strcat "\nSpecify Cross Height <" (rtos *cSze*) "> : "))) (list *Coord* *tHgt* *thOff* *tvOff* *cSze*))) (while (setq pt (getpoint "\nPick Point to Label <Exit> : ")) (_Cross (setq pt (trans pt 1 0)) *cSze*) (Text (polar (polar pt 0. *thOff*) (/ pi 2.) *tvOff*) *tHgt* (rtos (nth (cdr (assoc *Coord* pos)) pt)))) (princ))

I have a lisp for that but I don't remember where I had got it. (defun C:TLEN (/ ss tl n ent itm obj l) (setq ss (ssget) tl 0 n (1- (sslength ss))) (while (>= n 0) (setq ent (entget (setq itm (ssname ss n))) obj (cdr (assoc 0 ent)) l (cond ((= obj "LINE") (distance (cdr (assoc 10 ent))(cdr (assoc 11 ent)))) ((= obj "ARC") (* (cdr (assoc 40 ent)) (if (minusp (setq l (- (cdr (assoc 51 ent)) (cdr (assoc 50 ent))))) (+ pi pi l) l))) ((or (= obj "CIRCLE")(= obj "SPLINE")(= obj "POLYLINE") (= obj "LWPOLYLINE")(= obj "ELLIPSE")) (command "_.area" "_o" itm) (getvar "perimeter")) (T 0)) tl (+ tl l) n (1- n))) (alert (strcat "Total length of selected objects is " (rtos tl))) (princ) ) Edit: someone has to change selectionset on code for selecting by layer.