Leaderboard

Ok a few things (ssget '((0 . "TEXT"))) will allow you to select as many as you want at a time by window or one by one. So you want total of text picked ? (defun c:countext ( / tot val ss) (setq tot 0.0) (setq ss (ssget '((0 . "TEXT")))) (repeat (setq x (sslength ss)) (setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))) (setq tot (+ tot val)) ) (princ) ) (c:countext)

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

one way is to entmake it, using this basic code: (entmake '( (0 . "CIRCLE") ;make circle (62 . 3) ; colour (10 4.0 4.0 0.0) ; centre (40 . 1.0) ; radius )) ( https://help.autodesk.com/view/ACD/2016/ENU/?guid=GUID-D47983BA-1E5D-417D-85B8-6F3DE5F506BA) Pop that into your LISP and modify to suit what you want If you want to create this using variables, change the (entmake '( to (entmake (list (setq pt (list 0 0 0)) ;;insertion point (setq rad 1) (setq colour 3) ;colour code (setq layer "0") ; layer, as a string (entmake (list (cons 0 "CIRCLE") ;make circle (cons 62 colour) ; colour (cons 8 layer) ; colour (cons 10 pt) ; centre (cons 40 rad) ; radius )) and using the entmake codes you can use these for more conrol: 410 Drawn in tab 8 Layer 62 Colour 6 Linetype 48 Linetype Scale 370 Lineweight So up to you, if you need more help just say....

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

So toggle it for just this command. The error "bad argument type: VLA-OBJECT nil" is probably because the layer doesn't exist in that drawing. added an if statement to check for layer. if missing will let you know. --edit Layers that are in the xref have the name of the xref in front like this xref named "typical-motel-room" --edit had to build a list of layers that contain the strings in check (old l list) from there builds a new l list of the layers that need to be frozen or thawed. (defun c:foo (/ a n check lay match l) (setvar 'DYNMODE 1) ;set dynmode @ pointer (initget 0 (setq a "30 60 90")) (setq n (cond ((getkword (strcat "\nSelect Option [" (vl-string-translate " " "/" a) "] <30>: "))) ( "30") ) ) (setvar 'DYNMODE 0) ;turn off dynmode (foreach check '("TEST-PP-30%_Design_Review" "TEST-PP-60%_Design_Review" "TEST-PP-90%_Design_Review") (foreach lay (Table "layer") (if (wcmatch lay (strcat "*" check "*")) (setq match (cons lay match)) ) ) ) (foreach l match (vl-catch-all-apply 'vla-put-freeze (list (vlax-ename->vla-object (tblobjname "layer" l)) (if (wcmatch l (strcat "*" n "*")) 0 -1) ) ) ) (command "_.regen") (princ) ) ;Written By Michael Puckett. (defun Table (s / d r) (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) )

(defun c:countext ( / tot val ss) (setq tot 0.0) (setq ans "") (while (= ans "") (setq ss (ssget '((0 . "TEXT")))) (setq el (entget (ssname ss 0))) (repeat (setq x (sslength ss)) (setq val (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))) (setq tot (+ tot val)) ) (setq ans (getstring "\nSelection Finished [Y - Yes / SpaceBar - No] <SpaceBar>")) ) (princ "\n finished, result is = ") (princ tot) (setq pt (getpoint "\nSelect Total Insertion Point : ")) (setq txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3))) (rh:em_txt pt txt (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 little bit edit BIGAL's code, try this

Thanks a ton! I thought there might be a statement like "mapcar", but I couldn't for the life of me figure out how to google it. I see what you mean about not breaking the user settings routines outside the main command. To be honest, I'm not really sure why I was doing it that way to begin with. Thanks for showing me the non "command" methods to do a lot of these operations, I have a feeling that's where the problems were coming from. Your tips are gonna streamline my code quite a bit, I should've joined this forum months ago.

IMO DCL is not needed for this simple task. If you format the input correctly and have DYNMODE set to 1, it makes for a pretty clean interface. (defun c:foo (/ a n) (initget 0 (setq a "30 60 90")) (setq n (cond ((getkword (strcat "\nSelect Option [" (vl-string-translate " " "/" a) "] <30>: "))) ("30") ) ) (foreach l '("TEST-PP-30%_Design_Review" "TEST-PP-60%_Design_Review" "TEST-PP-90%_Design_Review") (vl-catch-all-apply 'vla-put-freeze (list (vlax-ename->vla-object (tblobjname "layer" l)) (if (wcmatch l (strcat "*" n "*")) 0 -1 ) ) ) ) (command "_.regen") (princ) )

Welcome. us cs rus complete shouldn't be broken out but run inside the same lisp. this allows you to control/define local variables. when you don't define local variables it makes them global variables and if your are running multiple lisp that could be a potential to get unexpected results. I always try to avoid using (command when i can it has the highest potential to mess up. vs setting a variable. plus even tho you have cmdecho set to 0 their could be output to the command line anyway. these do the same thing. (command "layer" "set" "dims" "") (setvar 'clayer "dims") Added a neat little trick with mapcar to set or get multiple variables at once. (defun c:crmrk ( / *error* lst val cnr pt1 pt2 pt3) (setq Drawing (vla-get-activedocument (vlax-get-acad-object))) ;needed for start and end marks (defun *error* (msg) (mapcar 'setvar lst val) (vla-endundomark Drawing) (princ msg) ) (setq lst (list 'CMDECHO 'OSMODE 'PICKBOX 'CLAYER) val (mapcar 'getvar lst) ;saves current var of above list ) (vla-startundomark Drawing) ;wont output to command line or affect selections (mapcar 'setvar lst '(0 5 0 "dims")) ;sets the list of system variables ;cmdecho = 0 ;osmode = 5 ;replaces (command "_.-osnap" "end,center") ;picking cursor ;pickbox = 0 ;i usually keep it at 5 ;clayer = "dims" ;replaces (command "layer" "set" "dims" "") (setq cnr (getpoint "\nPick Corner: ")) (setq pt1 (polar cnr pi 2.0)) (setq pt2 (polar pt1 4.71239 1.5)) (setq pt3 (polar pt2 0 1.5)) (command "_.Pline" "_non" pt3 "_non" pt2 "_non" pt1 "") (command "_.Rotate" (entlast) "" cnr "ref" 225 pause) (vla-endundomark Drawing) (mapcar 'setvar lst val) ;returns system variables back to what they where before command (princ) ) The error handling is if you exit out of this lisp or it errors (you don't pick point cnr) it will set the system variables back to what they where before the command was run.

I think it's because people don't use this method because it's too slow. I edited the gif to save your time. ; CTEXT & PTEXT - 2022.06.30 exceed ; step 1 - use CTEXT, copy all text's handle & textstring to excel (except locked or freezed) ; step 2 - edit in excel C column. ; step 3 - place your cursor in that table, press ctrl+a > ctrl+c ; step 4 - in CAD, press PTEXT to put your new text strings in there (vl-load-com) (defun c:CTEXT ( / *error* ss ssl index textlist obj hand textlayer textlayerobj layerlocked layerfreezed tstring indexr textlista indexc putstring xlcolumns ) (defun *error* ( msg ) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (ex:RELEASEEXCELforctcs) (princ) ) (setq ss (ssget "X" '((0 . "*text")))) (setq ssl (sslength ss)) (setq index 0) (setq textlist '()) (repeat ssl (setq obj (vlax-ename->vla-object (ssname ss index))) (setq hand (vlax-get-property obj 'handle)) (setq textlayer (vlax-get-property obj 'layer)) (setq textlayerobj (vlax-ename->vla-object (tblobjname "layer" textlayer))) (setq layerlocked (vlax-get-property textlayerobj 'lock)) (setq layerfreezed (vlax-get-property textlayerobj 'freeze)) (if (and (= layerlocked :vlax-false) (= layerfreezed :vlax-false)) (progn (setq tstring (vlax-get-property obj 'textstring)) (setq textlist (cons (list hand tstring) textlist)) ) (progn ;(princ "\n it's locked or freezed") ) ) (setq index (+ index 1)) ) (ex:ESMAKE) (setq indexr 0) (repeat (length textlist) (setq textlista (nth indexr textlist)) (setq indexc 0) (repeat (length textlista) (setq putstring (nth indexc textlista)) (ex:ECSELPUT (+ indexr 2) (+ indexc 1) (vl-princ-to-string putstring)) (ex:ECSELPUT (+ indexr 2) (+ indexc 2) (vl-princ-to-string putstring)) (setq indexc (+ indexc 1)) );end of repeat rows (setq indexr (+ indexr 1)) );end of repeat columns (ex:ECSELPUT 1 1 "handle") (ex:ECSELPUT 1 2 "old text") (ex:ECSELPUT 1 3 "new text") (ex:ECSELPUT 1 6 "How to Use : Fill new text cell > ctrl+a > ctrl+c > in cad run ptext") (setq xlcolumns (vlax-get-property acsheet 'Columns)) (vlax-invoke-method xlcolumns 'AutoFit) (ex:RELEASEEXCELforctcs) (princ) ) (defun c:PTEXT ( / *error* txtstring txtedit1 rowcount rowlast scstack index selectedrow selectedrowlist srllen subindex sclist ss1stacklist ss1count index2 enametoedit newtexttoedit objtoedit ) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (princ) ) (defun mysort ( l ) (vl-sort l '(lambda ( a b ) (if (eq (car a) (car b)) (< (caddr a) (caddr b)) (< (car a) (car b)) ;(< (vl-prin1-to-string (car a)) (vl-prin1-to-string (car b))) ) ) ) ) (setq txtstring (vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'GetData "Text")) (setq txtedit1 (LM:str->lst txtstring "\r\n")) (setq rowcount (length txtedit1)) (setq rowlast (last txtedit1)) (if (= rowlast "") (setq rowcount (- rowcount 1)) (setq rowcount rowcount) ) (setq scstack '()) (setq index 0) (repeat rowcount (setq selectedrow (nth index txtedit1)) (setq selectedrowlist (LM:str->lst selectedrow "\t")) (setq srllen (length selectedrowlist)) (setq subindex 0) (repeat srllen (setq selectedcell (nth subindex selectedrowlist)) (setq sclist '()) (setq sclist (list index selectedcell subindex)) (setq scstack (cons sclist scstack)) (setq subindex (+ subindex 1)) );end of repeat (setq index (+ index 1)) ) (setq ss1stacklist (mysort scstack)) (setq ss1count (length ss1stacklist)) (setq index2 3) (repeat (- (/ ss1count 3) 1) (setq enametoedit (handent (cadr (nth index2 ss1stacklist)))) (setq newtexttoedit (cadr (nth (+ index2 2) ss1stacklist))) (setq objtoedit (vlax-ename->vla-object enametoedit)) (vlax-put-property objtoedit 'textstring newtexttoedit) (setq index2 (+ index2 3)) ) (LM:endundo (LM:acdoc)) (princ) ) (defun ex:RELEASEEXCELforctcs ( / ) (if (= AcSheet nil) (progn) (progn (vlax-release-object AcSheet) ;(princ "\n Acsheet Release for next time. Complete.") ) ) (if (= Sheets nil) (progn) (progn (vlax-release-object Sheets) ;(princ "\n Sheets Release for next time. Complete.") ) ) (if (= Workbooks nil) (progn) (progn (vlax-release-object Workbooks) ;(princ "\n Workbooks Release for next time. Complete.") ) ) (if (= ExcelApp nil) (progn) (progn (vlax-release-object ExcelApp) ;(princ "\n ExcelApp Release for next time. Complete.") ) ) ) (defun ex:ECSELPUT ( r c textstring / c addr c1 c2 c3 rng textstring2 ) (setq c (- c 1)) (cond ((and (> c -1) (< c 25)) (setq c1 (+ c 1)) (setq addr (strcat (chr (+ 64 c1)) (itoa r) ":" (chr (+ 64 c1)) (itoa r) )) );end of cond option 1 ((and (> c 24) (< c 702)) (setq c2 (fix (/ c 26))) (setq c1 (- c (* c2 26))) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 2 ((and (> c 701) (< c 18278)) (setq c3 (fix (/ c (* 26 26)) ) ) (setq c2 (fix (/ (- c (* c3 (* 26 26))) 26))) (setq c1 (- (- c (* (* c3 26) 26)) (* c2 26))) (setq c3 c3) (setq c2 c2) (setq c1 (+ c1 1)) (setq addr (strcat (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r) ":" (vl-princ-to-string (chr (+ 64 c3))) (vl-princ-to-string (chr (+ 64 c2))) (vl-princ-to-string (chr (+ 64 c1))) (itoa r))) );end of cond option 3 );end of cond (setq c (+ c 1)) (setq rng (vlax-get-property acsheet 'Range addr)) (vlax-invoke rng 'Select) (setq textstring2 textstring) (vlax-put-property cell 'item r c textstring2) ) (defun ex:ESMAKE ( / ) ;from BIGAL's ah:chkexcel (setq excelapp (vlax-get-or-create-object "Excel.Application")) (vlax-invoke-method (vlax-get-property excelapp 'Workbooks) 'Add) (vlax-put Excelapp "visible" :vlax-true) (setq Workbooks (vlax-get-property ExcelApp 'Workbooks)) (setq Sheets (vlax-get-property ExcelApp 'Sheets)) (setq AcSheet (vlax-get-property ExcelApp 'ActiveSheet)) (setq accell (vlax-get-property ExcelApp 'Activecell)) (setq cell (vlax-get-property acsheet 'Cells)) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; String to List - Lee Mac ;; Separates a string using a given delimiter ;; str - [str] String to process ;; del - [str] Delimiter by which to separate the string ;; Returns: [lst] List of strings (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) There are already tons of text editing Lisp. inside of CAD, outside of CAD, or batch modifications. so this is for my handent practice. export all text contents of a drawing to Excel with CTEXT command with handle. and put your edits in the 3rd column then copying the whole table, then input PTEXT in CAD the content is pasted in the same text based on the handle. In the case of overlapping or moving, handles were used instead of coordinates. It doesn't matter if you save the Excel file and use it or delete all unnecessary rows. because it use your clipboard

Hi Steven. Thanks for your help. Your code is working perfectly. However I also came up with below code. (defun c:CSP ( / e1 eg1 p10 p11 mp e2 eg2 p20 p21 pt) ;; Circle @ Specific Point (if (and (setq e1 (car (entsel "\nSelect Line for Midpoint: "))) (setq eg1 (entget e1)) (setq p10 (cdr (assoc 10 eg1)) p11 (cdr (assoc 11 eg1))) (setq mp (mapcar '* (mapcar '+ p10 p11) '(0.5 0.5 05))) (setq e2 (car (entsel "\nSelect line where Circle will reside: "))) (setq eg2 (entget e2)) (setq p20 (cdr (assoc 10 eg2)) p21 (cdr (assoc 11 eg2))) (setq pt (inters mp (mapcar '- mp '(0 1 0)) p20 p21 nil)) );and (command "_.CIRCLE" "_non" pt pause) );if (princ) );defun

If you avoid using command calls using clean lisp like mhupp's example you could use acaddoc.lsp or an mnl file instead of s::startup to avoid those issues. Clean code executes quicker anyway. The newer command-s or vl-cmdf are cleaner and less buggy than command for newer versions like you're using.

When saving downloaded code adding the link to where you downloaded it as a comment like ; https://www.cadtutor.net/forum/topic/71014-lisp-to-run-a-calculation/page/2/#comment-570635 to the lisp so you can use it for follow-up questions as the link provides more complete information on what it was created to do and how it worked without needing to repost the already posted code.

When importing shp files with Map I've always converted them to polylines. Never actually worked with them outside of GIS.

I was saying that more for the fact they are anonymous blocks for a reason and/or could mess something when they aren't anymore. And it does the whole drawing. rather than process the ones you select.

UnAnon.Lsp assigns block names after checking to make sure the names aren't already in use, no caution needed. They can be renamed afterwards. Before Vehicle Tracking we used to use AutoTurn for vehicle paths and it made each of them an anonymous block, used UnAnon.Lsp for many years to fix them and hatches from many many earlier before they were improved which was probably what the lisp was created for in 1998. Might be the oldest routine I still use today, I've seen newer simular code but why fix something that's worked for me for so long?

Steven P agree if want corner can still use a select pline segment but pick near end that is used in this code. ; Pline segment with angle and length (defun c:plseg() (setq plent (entsel "\nSelect Pline ")) (setvar "osmode" 0) (setq pick (cadr plent) plObj (vlax-ename->vla-object (car plent)) pick2 (vlax-curve-getclosestpointto plobj pick) param (vlax-curve-getparamatpoint plObj pick2) segment (fix param) co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))) (setq pt1 (nth segment co-ord)) (setq pt2 (nth (+ segment 1) co-ord)) (if (= pt2 nil)(setq pt2 (nth 0 co-ord))) (setq len (distance pt1 pt2)) (setq ang (angle pt1 pt2)) (alert (strcat "angle is " (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3))) )

Thanks I love your lisp so much. I do not have a lot of knowledge about autolisp programming.Can you tutoriate me or control your lisp more completely?

Here's another way to set layer colors with a pick... will do index, truecolor and colorbooks. Could easily be modified to set the object color. (defun c:clc (/ c d e l n) ;; RJP » 2018-08-17 ;; Set layer color by pick (or (getenv "clc") (setenv "clc" "(62 . 1)")) (cond ((setq c (acad_truecolordlg (read (getenv "clc")))) (setenv "clc" (vl-prin1-to-string (last c))) (setq d (vla-get-activedocument (vlax-get-acad-object))) (while (setq e (nentsel "\nSelect entity to change layer color: ")) (foreach x (append (list (car e)) (cadddr e)) (cond ((setq n (cdr (assoc 8 (entget x)))) (setq l (tblobjname "layer" n)) (and (not (wcmatch n "0")) (entmod (append (entget l) c))) ) ) ) ) (vla-regen d acactiveviewport) ) ) (princ) )

This seems to do the trick. I would use with caution. (defun c:ub () (vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (setq nam (vla-get-name bl)) (if (= "*U" (substr nam 1 2)) (progn (setq nam2 (substr nam 2)) (vla-put-name bl nam2) (princ (strcat "\n" nam " ---> " nam2)) ) ) ) (princ) )

https://blog.draftsperson.net/anonymous-blocks-in-autocad/

Capitalization matters also its better to use setvar (defun C:TestAutoLoad () (Alert "Test") (Alert "Test2") (setvar 'clayer "Defpoints") (princ) ) (C:TestAutoLoad)

Have you tried the DaylightBasin subassembly? You can pretend your ditch is a basin and interrupt the slope, then continue the slope to the existing grade. You can define the slope or the width of either side of the ditch.