3dwannab Posted January 22, 2022 Posted January 22, 2022 (edited) I have wrote this LSP to ask the user to pick a gap tolerance before hatching and hatch the area. The program then gets the area and converts that to m2 and asks the user to pick a selection of either DTEXT or MTEXT to update. I was hoping at the every start of the program to draw a few temporary separate lines before asking for the gap tolerance to allow the user to divide the space up if needed or to close up any very large gaps. I did look at this example but it's way over my head. http://www.lee-mac.com/lisp/html/GrSnapV1-0.html Here's the program code below and it in action. (defun c:Area_Get_Picked_Mod_Text( / *error* var_hpislanddetection var_hpgaptol var_cmdecho var_nomutt var_osmode gaptolerance pthatch ss areainmmval areacmdstr mtextcontents i ent i str ent ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) ) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_cmdecho (getvar "cmdecho")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (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 'cmdecho 0) (setvar 'osmode 0) ; Get hpgaptol variable (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) ) ) ; Click the internal area for the hatching (graphscr) (setq pthatch (getpoint "\nClick internal point : "))(terpri) (command "-hatch" "_P" "_S" "_T" "70" "_A" "_G" gaptolerance "" pthatch "" ) ; Use the area command to get the last value (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) ; Select the MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the 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 ss (ssget '((0 . "MTEXT,TEXT")))) (setq ss (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) ; Modify the selected MTEXT with the area (if ss (repeat (setq i (sslength ss)) (setq ent (entget (ssname ss (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regex (vlax-create-object "Vbscript.RegExp")) (vlax-put-property regex "IgnoreCase" 1) (vlax-put-property regex "Global" 1) (setq regexp_oldstr "\\d+\\.?\\d*m[²|2]") (vlax-put-property regex "Pattern" regexp_oldstr ) (setq result (vlax-invoke-method regex "Replace" str mtextcontents) ) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; (command "._erase" "_L" pause) ; This will auto select the last item to get deleted. This is just for double checking it was hatched correctly. (command "._erase" "_L" "") ; This will delete the last object created. (setvar 'cmdecho var_cmdecho) (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (*error* nil) (princ) ) Edited January 22, 2022 by 3dwannab Quote
Linh Posted January 23, 2022 Posted January 23, 2022 Really nice function. Why you don't just draw line using (command "line") or something (entmake ... )? The Lee Mac function you were looking at is for jigging, I believe. It is used in combination with (grread ...) function: while in grread your cursor is moving, the coordinates is changing and the osnap mark of midpoint, center point, end point etc. show up to pick. Native grread function doesn't have those osnap marks. Lee Mac function is to add them to the grread functionality. All are based on a genius algorithm starts by Elpanov Evgeniy, I am not sure but that is as far as I know. Quote
Steven P Posted January 23, 2022 Posted January 23, 2022 (edited) Sunday Morning here so CAD is off.... and this idea i untested of course, so you might need to fiddle with it to make it work Adding temporary lines I would make a blank selection set, then in a loop use the line command to allow them to draw a line, add that to the selection set and ask if to draw another line or not ;;Loop for temporary lines (setq ss (ssadd)) ;; creates a blank selection set (setq LoopAgain "Y") ;; just a marker for a while loop (while (= LoopAgain "Y") (princ "Draw Line") (Command "Line" pause pause "") (setq ss (ssadd (entlast) ss)) (initget "Y N y n") (setq LoopAgain (strcase (getstring "Draw Another Line? (Y/N)"))) ) ;;; Do your stuff ;;; ;;delete lines (repeat (setq i (sslength ss)) ;;From https://www.cadtutor.net/forum/topic/73504-deleting-a-selection-set/ (entdel (ssname ss (setq i (1- i)))) ) Edited January 24, 2022 by Steven P Quote
tombu Posted January 24, 2022 Posted January 24, 2022 Check out https://www.cadtutor.net/forum/topic/70140-lisp-to-scale-by-moving-only-one-side/page/2/?tab=comments#comment-563855 Quote
3dwannab Posted January 24, 2022 Author Posted January 24, 2022 6 hours ago, tombu said: Check out https://www.cadtutor.net/forum/topic/70140-lisp-to-scale-by-moving-only-one-side/page/2/?tab=comments#comment-563855 Quite complex for me. As far as I can see it doesn't do quite what I'm after. On 1/23/2022 at 8:13 AM, Linh said: Really nice function. Why you don't just draw line using (command "line") or something (entmake ... )? Thanks, I did take a look at grread but thought there was an easier way for a novice like me. On 1/23/2022 at 10:06 AM, Steven P said: Sunday Morning here so CAD is off.... Thanks, I was wondering if there was a way for me to use the enter or space bar to continue and enter N or escape key to continue with the remainder of the program? ----------------------------------------- Here's what I have so far. I've added notes to the code to explain more what it does. If you can please comment on the code. Thanks. ; ; Area_Get_Picked_Mod_Text by 3dwannab ; ; First written on the 2022.01.22 ; It's a WIP! ; ; WHAT IS DOES: ; 1. First create a layerstate to restore that after and hide layers that ; contain things like, fur, dim, kitchen or hatch. ; 2. Then ask to draw temporary lines to close up any large gaps. ; 3. Asks the user for a gap tolerance. If no gaps are leading to the other ; model space then this doesn't need any value. ; 4. Pick an internal point inside the area that you have closed with the ; temporary lines. ; 5. Lastly, you can make a selection on the existing DTEXT or MTEXT to update ; the text. ; 6. And lastly, lastly it'll remove the temporary lines you had created. ; ; TO DO: ; Better error handling. ; ; NOTES: ; - 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_Picked_Mod_Text( / *error* areacmdstr areainmmval ent gaptolerance i h mtextcontents pthatch ssLines ssHatches ssText stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; 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_Picked.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_osmode) ) ; 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_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 (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 'hptransparency "22") ; This must be a string. (setq stateName "3dwannab_Area_Get_Picked") (progn ; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ; Hide any layers (command "-layer" "_OFF" "*fur*" "") (command "-layer" "_OFF" "*dim*" "") (command "-layer" "_OFF" "*kitchen*" "") (command "-layer" "_OFF" "*hatch*" "") ; Loop to draw temporary lines ; Sets osmode for Endpoint, midpoint, quadrant and perpendicular. keeping it simple. (setvar 'osmode 147) (setq ssLines (ssadd)) ; creates a blank selection set (setq LoopAgain "Y") ; just a marker for a while loop (while (= LoopAgain "Y") (princ "Draw Line to close up any large spaces or divide them : ") (Command "Line" pause pause "") (setq ssLines (ssadd (entlast) ssLines)) (setq LoopAgain (strcase (getstring "Draw Another Line? (Y/N) :"))) ) ; 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) ; (princ (strcat "\n" (getvar "hpgaptol") "\n")) ; Click the internal area for the hatching (princ "Pick inside an area you want to calculate : ") (command "_.bhatch") ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatching-by-lisp/m-p/5923832/highlight/true#M336978 (setq ssHatches (ssadd)) ; creates a blank selection set (setq ssHatches (ssadd (entlast) ssHatches)) ; Loop the hatch command until the user exits or returns out it (while (> (getvar 'cmdactive) 0) (progn ; Some defunct testing code ; (if (wcmatch ((getvar 'lastprompt) "Valid hatch boundary not found.")) ; (princ "not ok") ; (princ "ok") ; ) (command pause) (setq ssHatches (ssadd (entlast) ssHatches)) ) ) ; while end ; Use the area command to get the last value (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) ; Select the DTEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the DTEXT and/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) ; Modify the selected DTEXT 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 ) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- (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_Picked_New_Text\" or \"Area_Get_Picked_Mod_Text\" to run Program" ) ) (princ) Quote
Linh Posted January 25, 2022 Posted January 25, 2022 (while (= (setq sp (getpoimt "\nDraw Line to close up spaces or divide them - Start Point: ")) (setq ep (getpoimt "\nNext Point (enter to skip): ")) ) (Command "._Line" sp ep "") (setq ssLines (ssadd (entlast) ssLines)) ) I think the more natural way is no keyword at all, just let user pick point pick point to draw line until he/she skip one pick point request. To have "Y" or "N" keywords, look at getkword and initget function, quite basic ones. 1 Quote
3dwannab Posted January 25, 2022 Author Posted January 25, 2022 Thanks, I did try that but failed. But, done. LeeMac for inspiration again. ; 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) ; Sets osmode for Endpoint and midpoint. keeping it simple. (setq ssLines (ssadd)) ; creates a blank selection set (setq msgLineDraw "\nDo you want to draw a line to close any gaps? [Yes/No] <Yes>: ") (while (progn (initget "Yes No") (/= "No" (getkword msgLineDraw)) ) (progn (setq msgLineDraw "\nDraw another gap closing line? [Yes/No] <Yes>: ") (Command "Line" pause pause "") (setq ssLines (ssadd (entlast) ssLines)) ) ) Quote
Steven P Posted January 25, 2022 Posted January 25, 2022 18 hours ago, 3dwannab said: Thanks, I was wondering if there was a way for me to use the enter or space bar to continue and enter N or escape key to continue with the remainder of the program? Yes, if you take out the (initget "Yes No") and make the next '(progn' .... ). In fact the blow loop will continue as long as the user doesn't enter N or No (space, enter, Y all OK) (progn (setq MyAnswer (strcase (getstring msgLineDraw))) ;;strcase in case user answers no, No, NO, or nO (and (/= "NO" MyAnswer)(/= "N" MyAnswer)) ;;So user can answer No or N ) You are using (setvar 'osmode... which works, however you might want to set it back to how it was to start with when you have finished, you might be dong that already, just so CAD performs as it did before the LISP Something like (setq osmodeold (getvar 'osmode)) (setvar 'osmode 3) ... do your stuff... .. then at the end... (setvar 'osmode osmodeold) and it might be handy to do an error trap in case the user presses escape and cancels the LISP between setting osmode and setting it back again.... google can be your friend here Linh has a typing error so that's why it won't work. Quote
Steven P Posted January 25, 2022 Posted January 25, 2022 Just playing with this, happier with this for you: (defun c:trythis ( / MyPoint ss Myloop) ;;; errortrap here if you want to to reset 'osmode to what ;;; it was and to delete the lines you add ;;; also add a start undo mark here, press undo will remove ;;; the lines you have added ;;; You might have these already and they aren't necessary (setq osmodeold (getvar 'osmode)) ;;record existing snap settings (setvar 'osmode 3) ;;set snaps to what you want (setq ss (ssadd)) ;;create empty selection set (setq Myloop "loop") ;;marker to whether to loop again or end the loop (while (= "loop" Myloop ) ;;Loop if loop marker says 'loop' (setq MyPoint (getpoint "\nDraw Line, [Space or Enter to end]: ")) (if (= MyPoint nil) (setq Myloop "StopLoop") ;; if no point is selected (enter or spae pressed) (progn ;;else do this loop (Command "._Line" MyPoint pause "") (setq MyPoint nil) ;;might not be needed, but why not have this (setq ss (ssadd (entlast) ss)) ;;add line to selection set (as item 0, the previous line is line 1, etc) ) ) ) ;end while (setq ss (reverse ss)) ;; reverses the selection set so item 0 is the first line you drew, item n is the last ;;; Do your stuff ;;; ;;delete lines (repeat (setq i (sslength ss)) ;;From https://www.cadtutor.net/forum/topic/73504-deleting-a-selection-set/ (entdel (ssname ss (setq i (1- i)))) ;;delete the last item in the selection set, loop till length of selection set is 0 ) (setvar 'osmode osmodeold) ;;reset snaps (princ "Done")(princ) ;;report 'done' ) tried to add comments how it works Changed around the line creation so that if you don't select a start point it ends, then uses that start point in the normal command so you can see the line you are drawing... I prefer to see the line as I am drawing them as opposed to just selecting points blindly. 1 Quote
3dwannab Posted January 25, 2022 Author Posted January 25, 2022 (edited) Thanks Steven!! That is exactly what I'm after. That's a really quick method. See the delete lines section at the bottom. Would I need to put that in the *error* handler like so? See my take on it below and also my take on using (if ssLines (command-s "_.Erase" ssLines "")) Full error handler. (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; 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) ) ) Edit 1: There's an error with this msg: ; error: bad argument type: listp <Selection set: 15b> But I'll figure that out. Edit 2: Culprit below (I fixed this by removing this and used the command-s method I have below in the error handler.) (setq ss (reverse ss)) ;; reverses the selection set so item 0 is the first line you drew, item n is the last Edited January 25, 2022 by 3dwannab 1 Quote
Steven P Posted January 25, 2022 Posted January 25, 2022 For the error handler I think so... but I will admit to being bad at this - most of the LISPS I make up are for me, so I know what will go wrong with them... and I don't put them in as much as I should. Just noticing that I used ss for the selection set, you used ssLines, I'll have to remember that - is that why the reverse didn't work I wonder. Quote
3dwannab Posted January 25, 2022 Author Posted January 25, 2022 (edited) ssLines is just for me to remember what that selection set was for and not to overlap any variables. Plus ss is a bit vague for my liking. Error handling is not my strong suit either as you can probably see from the code below. Here's the latest one. Seems to be exactly what I was after. There's a total of 3 commands to choose from. See the code for the notes on what they badly do (vl-load-com) ; Quick loaders for the scripts below. (defun c:--LDArea_Get_Picked_New_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Picked_New_Text))) (defun c:--LDArea_Get_Picked_Mod_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Picked_Mod_Text))) (defun c:--LDArea_Get_Area_Mod_Text ( / ) (progn (LOAD "3dwannab_Area_Get") (C:Area_Get_Area_Mod_Text))) ; ; Area_Get_Area_Mod_Text by 3dwannab ; ; First written on the 2022.01.24 ; It's a WIP! ; ; WHAT IS DOES: ; 1. Will prompt the user to use the area command. ; 2. Then once enter or space bar is pressed, you can then select the TEXT or ; MTEXT to update it with the new area in m². ; ; TO DO: ; Nothing at the time of writing :) ; ; NOTES: ; - The units used must be decimal. ; - 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_Area_Mod_Text ( / *error* areacmdstr areainmmval ent i mtextcontents pthatch regexp_oldstr result ssText str var_cmdecho var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'nomutt var_nomutt) (setvar 'cmdecho var_cmdecho) (setvar 'osmode var_osmode) ) (setq var_cmdecho (getvar "cmdecho")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (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 'cmdecho 0) (setvar 'osmode 3) ; Sets osmode for Endpoint and midpoint. keeping it simple. ; Enter the area command (command-s "area" pause "" "") ; Use the area command to get the last value (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) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/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 . "*TEXT")))) (setvar 'nomutt 0) ; 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 (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)) (*error* nil) (princ) ) ; CREATED BY: alan thompson 11.28.07 ; MODIFIED BY: alan thompson 12.19.07 (MTEXT instead of TEXT, lot numbering works better, etc.) ; MODIFIED BY: 3dwannab 20.01.22 ; ; WHAT IS DOES: ; 1. Will prompt the user to use the area command. ; 2. Then once enter or space bar is pressed, you can then select the TEXT or ; MTEXT to update it with the new area in m². ; ; TO DO: ; Update to draw temp lines, the same as Area_Get_Picked_Mod_Text. ; ; NOTES: ; Just modified slightly to work with decimals as units. ; Prompts the user to pick a distance for the HATCH gap tolerance. This is useful for when there's doorways that need closing. ; Asks user for the height of the MTEXT. ; Outputs '95.78m²' to the MTEXT object and 'Area in m²: 95.78' to the command line. (defun c:Area_Get_Picked_New_Text ( / *error* areacmdstr areainmmval gaptolerance gaptoleranceDefault mtextcontents pthatch var_cmdecho var_hpgaptol var_hpislanddetection ; var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) ; (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) ) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_cmdecho (getvar "cmdecho")) ; (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (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 'cmdecho 0) (setvar 'osmode 0) ; Get saved offset from registry or default to 1 (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) ) ) ; Click the internal area for the hatching (graphscr) (setq pthatch (getpoint "\nClick internal point : "))(terpri) (command "-hatch" "_T" "70" "_A" "_G" gaptolerance "" pthatch "" ) (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)) (command "._erase" "_L" pause) ; This will auto select the last item to get deleted. This is just for double checking it was hatched correctly. ; (command "._erase" "_L" "") ; This will delete the last object created. (setq mtextcontents (strcat areainmmval "m\U+00B2")) (princ (strcat areacmdstr)) (command "._MTEXT" pthatch "_J" "_MC" "_C" "_N" "_H" pause pthatch mtextcontents "") (setvar 'cmdecho var_cmdecho) (setvar 'osmode var_osmode) (*error* nil) (princ) ) ; ; Area_Get_Picked_Mod_Text by 3dwannab ; ; First written on the 2022.01.22 ; It's a WIP! ; ; WHAT IS DOES: ; 1. First create a layerstate to restore that after and hide layers that ; contain things like, fur, dim, kitchen or hatch. ; 2. Then ask to draw temporary lines to close up any large gaps. ; 3. Asks the user for a gap tolerance. If no gaps are leading to the other ; model space then this doesn't need any value. ; 4. Pick an internal point inside the area that you have closed with the ; temporary lines. ; 5. Lastly, you can make a selection on the existing TEXT or MTEXT to update ; the text. ; 6. And lastly, lastly it'll remove the temporary lines you had created. ; ; TO DO: ; Nothing at the time of writing :) ; ; NOTES: ; - The units used must be decimal.; - 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_Picked_Mod_Text ( / *error* areacmdstr areainmmval ent gaptolerance h i linePt loopForDrawLines msgLineDraw mtextcontents pthatch ssHatches ssLines ssText stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; 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_osmode) ) ; 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_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 (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 'hptransparency "22") ; This must be a string. (setq stateName "3dwannab_Area_Get") (progn ; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ; Hide any layers (command "-layer" "_OFF" "*fur*" "") (command "-layer" "_OFF" "*dim*" "") (command "-layer" "_OFF" "*kitchen*" "") (command "-layer" "_OFF" "*hatch*" "") (command "-layer" "_OFF" "*door*" "") ; 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' (setq MyPoint (getpoint "\nDraw gap filling line \[ Press SPACE or ENTER to end ) : ")) (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) ; (princ (strcat "\n" (getvar "hpgaptol") "\n")) ; Click the internal area for the hatching (princ "Pick inside an area you want to calculate : ") (command "_.bhatch") ; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hatching-by-lisp/m-p/5923832/highlight/true#M336978 (setq ssHatches (ssadd)) ; creates a blank selection set (setq ssHatches (ssadd (entlast) ssHatches)) ; Loop the hatch command until the user exits or returns out it (while (> (getvar 'cmdactive) 0) (progn ; Some defunct testing code ; (if (wcmatch ((getvar 'lastprompt) "Valid hatch boundary not found.")) ; (princ "not ok") ; (princ "ok") ; ) (command pause) (setq ssHatches (ssadd (entlast) ssHatches)) ) ) ; while end ; Use the area command to get the last value (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) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/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) ; 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 ) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- (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_Picked_New_Text\" or \"Area_Get_Picked_Mod_Text\" to run Program" ) ) (princ) Edited January 25, 2022 by 3dwannab 1 Quote
Linh Posted January 26, 2022 Posted January 26, 2022 (setq ssLines (ssadd));needs this one initialized (while (and ;and, not = ;getpoint, not getpoimt (setq sp (getpoint "\nDraw Line to close up spaces or divide them - Start Point: ")) (setq ep (getpoint "\nNext Point (enter to skip): " sp));add sp as basepoint ) (Command "._Line" sp ep "") (setq ssLines (ssadd (entlast) ssLines)) ) Sorry my code need some debugged and fixed as above. My eyes must be very bad to type getpoimt instead of getpoint 1 1 Quote
BIGAL Posted January 26, 2022 Posted January 26, 2022 Noticed a initget this may be useful for yes no. (SETQ reply (ACET-UI-MESSAGE "Draw a line to close any gaps? " "Yes No Choice" (+ Acet:YESNOCANCEL Acet:ICONWARNING) ) ) ;; Yes = 6 ;; No = 7 ;; Cancel = 2 (IF (= reply 6) (PROGN (ALERT "Yep") ;; ;; More Yes Mojo ) ;; else (PROGN (ALERT "Nope") ;; ;; More no mojo ) ) 2 Quote
3dwannab Posted January 26, 2022 Author Posted January 26, 2022 (edited) Thanks Big G for that. I like the simplicity of no dialogs with the version from Steven P. I fixed a bug that I had with an (ssadd (entlast) ssLines) outside a while loop so it was deleting the last item. EDIT ON THIS: I still have an issue with it, trying to figure it out. EDIT 2 with fix I think! I set the two selection sets to nil. Probably not the best way to do it though. (if (wcmatch (strcase (getvar 'lastprompt)) "*HATCH BOUNDARY NOT*") ; (princ "\nno hatch bond found\n") (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) ) (princ "\nok\n") ) ------ Also hide all layers, then unhide layers with wall, window and annotation layers. This cleans the area, ready for hatching. Then I added some error checking with this to exit the program if not hatch boundary was found after finishing the hatching step. ; Here it checks the lastprompt variable and if it finds: ; Valid hatch boundary not found. ; Then the program will exit. (if (wcmatch (strcase (getvar 'lastprompt)) "*HATCH*NOT*") (exit) ) Update code below. ; ; Area_Get_Picked_Mod_Text by 3dwannab ; It's a WIP! ; ; First written on the 2022.01.22 ; Last modified on the 2022.01.26 ; ; WHAT IS DOES: ; 1. First create a layerstate to restore that after and hide layers that ; contain things like, fur, dim, kitchen or hatch. ; 2. Then ask to draw temporary lines to close up any large gaps. ; 3. Asks the user for a gap tolerance. If no gaps are leading to the other ; model space then this doesn't need any value. ; 4. Pick an internal point inside the area that you have closed with the ; temporary lines. ; 5. Lastly, you can make a selection on the existing TEXT or MTEXT to update ; the text. ; 6. And lastly, lastly it'll remove the temporary lines you had created. ; ; 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_Picked_Mod_Text ( / *error* areacmdstr areainmmval ent gaptolerance h i linePt loopForDrawLines msgLineDraw mtextcontents pthatch ssHatches ssLines ssText stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; 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_osmode) ) ; 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_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 (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 'hptransparency "22") ; This must be a string. (setq stateName "3dwannab_Area_Get") (progn ; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ; Hide any layers ; (command "-layer" "_OFF" "*fur*" "") ; (command "-layer" "_OFF" "*dim*" "") ; (command "-layer" "_OFF" "*kitchen*" "") ; (command "-layer" "_OFF" "*hatch*" "") ; (command "-layer" "_OFF" "*door*" "") ; This way hides all then turns on the window and any annotation layers. (command "-layer" "_OFF" "*" "" "") (command "-layer" "_ON" "*wall*" "") (command "-layer" "_ON" "*window*" "") (command "-layer" "_ON" "0" "") (command "-layer" "_ON" "*AN*" "") ; 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' (setq MyPoint (getpoint "\nDraw gap filling lines?\n\nPress 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 (princ "Pick inside an area you want to calculate : ") (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)) ; 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. (if (wcmatch (strcase (getvar 'lastprompt)) "*HATCH*NOT*") (exit) ) ; Use the area command to get the last value (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) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/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) ; 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 ) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- (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_Picked_New_Text\" or \"Area_Get_Picked_Mod_Text\" to run Program" ) ) (princ) Fix for that. I've also added undo marks in there. ; ; Area_Get_Picked_Mod_Text by 3dwannab ; It's a WIP! ; ; First written on the 2022.01.22 ; Last modified on the 2022.01.26 ; ; WHAT IS DOES: ; 1. First create a layerstate to restore that after and hide layers that ; contain things like, fur, dim, kitchen or hatch. ; 2. Then ask to draw temporary lines to close up any large gaps. ; 3. Asks the user for a gap tolerance. If no gaps are leading to the other ; model space then this doesn't need any value. ; 4. Pick an internal point inside the area that you have closed with the ; temporary lines. ; 5. Lastly, you can make a selection on the existing TEXT or MTEXT to update ; the text. ; 6. And lastly, lastly it'll remove the temporary lines you had created. ; ; 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_Picked_Mod_Text ( / *error* areacmdstr areainmmval ent gaptolerance h i linePt loopForDrawLines msgLineDraw mtextcontents pthatch ssHatches ssLines ssText stateName str var_cmdecho var_hpgaptol var_hpislanddetection var_hpislanddetectionmode var_hpname var_hpquickpreview var_hptransparency var_nomutt var_osmode ) (vl-load-com) (vla-StartUndoMark (setq *doc* (vla-get-ActiveDocument (vlax-get-acad-object)))) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) ; Deletes the temporary lines and hatches (if ssLines (command-s "_.Erase" ssLines "")) (if ssHatches (command-s "_.Erase" ssHatches "")) ; 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_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_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 (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 'hptransparency "22") ; This must be a string. (setq stateName "3dwannab_Area_Get") (progn ; Save the layer states here before hiding layers below (layerstate-save stateName nil nil) ; 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*" "") ; 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?\n\nPress 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 (princ "Pick inside an area you want to calculate : ") (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)) ; 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 (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) ; Select the TEXT and/or MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the TEXT and/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) ; 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 ) (vla-EndUndoMark *doc*) (*error* nil) (princ) ) Edited January 26, 2022 by 3dwannab added update to the code Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.