Leaderboard

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)

Unfortunately you were not advised to write HARDENT, you were advised to write (HANDENT .... AutoCAD needs to have a way to distinguish between AutoCAD commands and AutoLISP expressions. AutoCAD identifies an AutoLISP expression by its opening parenthesis. Each time AutoCAD detects an opening parenthesis, it passes the entire expression which follows to AutoLISP. AutoLISP evaluates the expression and returns the result to AutoCAD. AutoCAD uses the results and continues. A typical AutoLISP expression has this syntax: (function argument) It is a pity that you did not manage to discover this with your search of information.

At some point the lighgtbulb will go on. Lisp has to be contained in parenthesis () there is nothing to download it is built in re-read @tombu's post above and include the (). And it is HANDENT not HARDENT Or is your profile not correct and you are actually using LT and not the full version of Autocad in which case nothing will help as Lisp is not found in LT

Apparently you did not read the above post

That's fine, some people can, some people can't... See how you do with the program Maratovich suggested, not free but $5 for a year sounds good value, and if it is no good come back and see what we can think of

I Can't write a lisp code

Unfortunately in LT I don't think there is a way to 'read' the name of a block, in a diesel macro you could in theory find the last digit and add an underscore before it, but I don't know of a way to get at the block name to do that. No doubt that is an option with Lisp but this is one of the limitations of LT. You can in LT create new blocks and use a macro to give a name with an incremental number but reading the name of an existing block is to the best of my knowledge not possible.

I updated the code in my post above to repeat until you press the Esc key.

You can attach an xref with LISP, (command "-xref" "Attach" "MyXref.dwg" "0,0" "" "" ""). You can attach another xref with a LISP, (command "-xref" "Attach" "AnotherXref.dwg" "0,0" "" "" ""), so I reckon it is possible, yes. Once you can attach multiple XRefs to a single file then you can apply that to many files using one of the batch routines out there, I think Lee Mac has one, or you can look at the core console which will be quicker. So... how are you with writing LISP routines and using core console or batch routines? Once we know that, we cam give you the right amount of help, not too little so you don't get wha you want, and not too much that we do thigs that you are very capable of doing yourself.

Lol sigh people, smarty pants same goes for my post. As you see on the top. Writing HARDENT like the link says gives me the error unknown command.