All Activity
This stream auto-updates
- Past hour
-
Get VALUE of Attribute in Block and insert in new block
tmelancon replied to tmelancon's topic in AutoLISP, Visual LISP & DCL
Would even be open to a modification of adding multiple attributes in the future, i.e. drawing dates and stuff like that from the old title blocks. If anyone is up for the challenge I greatly appreciate any and all support. I am also working on debugging the current code, I have just been out of LISP for a minute -
This is very useful as well. Especially if I can find a way to run it on directorys. Any chance changing the date values to current date code like above is easy (Rev date MM/DD/YY & stamp date MMM DD, YYYY)? As you may have seen I have not figured that out yet. This is really cool! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:revbox(/ acount revisionboxtext listlength ent entlist) ;;adds revbox text ;;Make array of texts to change ;;- "prompt" "new text"- ;;add lines here to suit (setq revisionboxtext (list '"MAIN REVISION" '"A")) (setq revisionboxtext (append revisionboxtext (list '"REVISION NO." '"A"))) (setq revisionboxtext (append revisionboxtext (list '"REVISION DATE" '"07/18/19"))) (setq revisionboxtext (append revisionboxtext (list '"DRAWN BY" '"BRS"))) (setq revisionboxtext (append revisionboxtext (list '"REVISION DESCRIPTION" '"ISSUED FOR APPROVAL"))) (setq revisionboxtext (append revisionboxtext (list '"CHECKED BY" '"SC"))) (setq revisionboxtext (append revisionboxtext (list '"APPROVED BY" '"DEE"))) (setq revisionboxtext (append revisionboxtext (list '"STAMP DESCRIPTION" '"ISSUED FOR APPROVAL"))) (setq revisionboxtext (append revisionboxtext (list '"STAMP DATE" '"JUL 18, 2019"))) ;;Loop through array and change rev box details (setq acount 0) (setq listlength (length revisionboxtext)) (while (< acount listlength) (princ "\n") (setq ent (car (nentsel (strcat "\nSelect " (nth acount revisionboxtext) " Text:")))) (setq entlst (entget ent)) (setq entlst (subst (cons 1 (nth (+ 1 acount) revisionboxtext)) (assoc 1 entlst) entlst)) (entmod entlst) (entupd ent) (setq acount (+ 2 acount)) ) (princ) )
-
Thanks Steven I'll check that out. I utilize Lee Macs MacAtt as well as Bfind. When the date does change it is unique to each DWG so we just Bfind it. I have been wanting to update this lisp to add all used Title Blocks or find an alternative. I will definitely try this one out. Sounds like Lee Macs UpdateTitleBlock routine but without the CSV which I would like. Thanks again!
- Today
-
jagadeesh joined the community
-
jimmy_mc joined the community
-
Get VALUE of Attribute in Block and insert in new block
tmelancon replied to tmelancon's topic in AutoLISP, Visual LISP & DCL
dlanorh, Thanks for your kind reply. I do appreciate all of your hard work. I am getting the following error: Error: ActiveX Server returned the error: unknown name: "GETATTRIBUTES" -
steph60 joined the community
-
REQUIRE LISP FOR POINT OBJECT (export in Offset & elevation)
Ish replied to Ish's topic in AutoLISP, Visual LISP & DCL
no solution from my cadtutor member. -
Is there a separate gap detection command in autocad that highlights tiny gaps of closed polygons? I render my drawings in photoshop and often there are small gaps that appear in my work or the work that I get from others. Right now only hpgaptol and using hatch command highlights the small gaps.
-
Often I am asked to put on a date other than today, say to send a drawing out tomorrow (or one we should have sent out yesterday...) so I prefer to manually type it in. Lee Mac also has a function for entering a date. Also if you have a few drawings to change Lee Macs MacAttEdit isn't a bad place to start - it remembers between drawings the last inputs and can work as a batch, you don't need to modify the LISP code to make changes. I also have this as an alternative. Go into the LISP code, and change the revisionboxtext lists to suit your project, run the lisp and select according to the prompt each bit of text in the block to change. It takes a bit longer than yours however it is not relying on a specific named title block (for example we have title blocks A1, A2, A3 etc in one project - this will cover them all). it won't let you skip past an attribute so just have to fill in the next one a couple of times until is loops round to fill it in if you want to skip something ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:revbox(/ acount revisionboxtext listlength ent entlist) ;;adds revbox text ;;Make array of texts to change ;;- "prompt" "new text"- ;;add lines here to suit (setq revisionboxtext (list '"REV CODE" '"A")) (setq revisionboxtext (append revisionboxtext (list '"DATE" '"11/07/19"))) (setq revisionboxtext (append revisionboxtext (list '"Rev Comment" '"ISSUE 1"))) (setq revisionboxtext (append revisionboxtext (list '"Drawn" '"SP"))) ;;Loop through array and change rev box details (setq acount 0) (setq listlength (length revisionboxtext)) (while (< acount listlength) (princ "\n") (setq ent (car (nentsel (strcat "\nSelect " (nth acount revisionboxtext) " Text:")))) (setq entlst (entget ent)) (setq entlst (subst (cons 1 (nth (+ 1 acount) revisionboxtext)) (assoc 1 entlst) entlst)) (entmod entlst) (entupd ent) (setq acount (+ 2 acount)) ) (princ) )
-
FIND AND REPLACE MULTYPLE LETTERS
Steven P replied to prodromosm's topic in AutoLISP, Visual LISP & DCL
This might give you a start, command txtreplace which you could modify to accept multiple inputs and then run the FindReplaceAll function for each letter. Note this is case sensitive. ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:txtreplace( / old_text new_text) (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): ")) (setq new_text (getstring T "NEW text to use: ")) (FindReplaceAll old_text new_text) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; FindReplaceAll - Changes Text, Mtext, Dimensions and Attribute Block entities ; that have a Find$ string with a Replace$ string. ; Arguments: 2 ; Find$ = Phrase string to find ; Replace$ = Phrase to replace it with ; Syntax: (FindReplaceAll "old string" "new string") ; Returns: Updates Text, Mtext, Dimension and Attribute Block entities ; It is Case sensitive ;------------------------------------------------------------------------------- (defun FindReplaceAll (Find$ Replace$ / [email protected] BlkEntName^ BlkEntType$ Cnt# [email protected] DimEntName^ DimEntType$ [email protected] EntName^ EntType$ FindReplace: Mid$ Mid2$ NewText$ Num# Replace$ SS& Text$) ;----------------------------------------------------------------------------- ; FindReplace: - Returns Str$ with Find$ changed to Replace$ ; Arguments: 3 ; Str$ = Text string ; Find$ = Phrase string to find ; Replace$ = Phrase to replace Find$ with ; Returns: Returns Str$ with Find$ changed to Replace$ ;----------------------------------------------------------------------------- (defun FindReplace: (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen#) (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$)) (while Loop (setq Mid$ (substr NewStr$ Cnt# FindLen#)) (if (= Mid$ Find$) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#))) Cnt# (+ Cnt# ReplaceLen#) );setq (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while NewStr$ );defun FindReplace: ;----------------------------------------------------------------------------- ; Start of Main function ;----------------------------------------------------------------------------- (if (and (= (type Find$) 'STR)(= (type Replace$) 'STR)(/= Find$ "")) (progn (if (setq SS& (ssget "x" (list '(-4 . "<AND")'(-4 . "<OR")'(0 . "TEXT")'(0 . "MTEXT")'(0 . "DIMENSION")'(0 . "INSERT")'(-4 . "OR>")(cons 410 (getvar "CTAB"))'(-4 . "AND>")))) (progn (command "UNDO" "BEGIN") (setq Cnt# 0) (repeat (sslength SS&) (setq EntName^ (ssname SS& Cnt#) [email protected] (entget EntName^) EntType$ (cdr (assoc 0 [email protected])) Text$ (cdr (assoc 1 [email protected])) );setq (if (= EntType$ "INSERT") (if (assoc 66 [email protected]) (progn (while (/= (cdr (assoc 0 [email protected])) "SEQEND") (setq [email protected] (entget EntName^)) (if (= (cdr (assoc 0 [email protected])) "ATTRIB") (progn (setq Text$ (cdr (assoc 1 [email protected]))) (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$)) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 [email protected]) [email protected])) (entupd EntName^) );progn );if );progn );if (setq EntName^ (entnext EntName^)) );while );progn );if (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace: Text$ Find$ Replace$)) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 [email protected]) [email protected])) (entupd EntName^) );progn );if );if (setq Cnt# (1+ Cnt#)) );repeat (command "UNDO" "END") );progn );if );progn );if (princ) );defun FindReplaceAll ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -
CHANGE ALL LAYERS TO DEFAULT LINEWEIGHT AUTOCAD LISP
SLW210 replied to Efeezy's topic in AutoLISP, Visual LISP & DCL
LAYTRANS has been around a while. AutoCAD 2016 and newer. -
I believe the variable is ENBLVPLSCL.
-
Diversion Drain linetype
ReMark replied to ALLI's topic in The CUI, Hatches, Linetypes, Scripts & Macros
Did you try changing the LTSCALE setting? -
scatler joined the community
-
yogesh sawant joined the community
-
require millimeter text to feet & INCHES
yogesh sawant posted a topic in AutoLISP, Visual LISP & DCL
I am getting room text with picking two points but i want that millimeter text converted in to feet & inches (defun c:RTT1 () (setq lu (getvar "lunits")) (setq lup (getvar "luprec")) (setvar "cmdecho" 0) (setq p1 (getpoint "\nenter first point :")) (setq p3 (getcorner p1 "\nenter second point :")) (setq st (getstring T "\nEnter Room Name :")) (setq sty (getvar "textstyle")) (setq ht (cdr(assoc 40 (tblsearch "style" sty)))) (if (= ht 0) (setq txht (getdist "\nEnter text height:")) (setq txht ht) ) (setq xd (abs (- (car p1) (car p3))) yd (abs (- (cadr p1) (cadr p3)))) (setq sxd (rtos xd lu lup) syd (rtos yd lu lup)) (setq txt (strcat sxd " x " syd)) (setq midp (polar p1 (angle p1 p3) (/ (distance p1 p3)2.0))) (setq secp (polar midp (dtr 270) (* txht 2.5))) (if (= ht 0) (command "text" "m" midp txht "0" st "text" "m" secp txht "0" txt) (command "text" "m" midp "0" st "text" "m" secp "0" txt)) (setvar "cmdecho" 1) ) -
fawaz joined the community
-
HI i am searching for a lisp to replace multyple letters from mtext for exaple to replaxe A,B,C,D,E,F,G,K,L,,M,N WITH Α,Β,Γ,Δ,Ε,Ζ,Η,Θ,Ι,Κ ...... THANKS
-
Offset for each circle center (x,y) from origin and make table
syedmeesamali replied to syedmeesamali's topic in AutoLISP, Visual LISP & DCL
Many Thanks. Just sharing my final image so that it can a good reference for somebody looking for similar problem. In the meanwhile I am trying to get better grasp of VLisp as I have background in Java, C++, Python and VBA (very different from list programming). -
ducdudl2018 joined the community
-
shankar joined the community
-
If you don't want a block then a lisp will do it.
- Yesterday
-
Good morning all, I am trying to create a linetype that uses a polyline/block to create a series of thicker arrows. I have written: *DIVERSION,DIVERSION DRAIN -----> -----> A,.982117,-.256835,[DIVERSION,DIVERSION.SHX,X=0,S=.25].977201 But it does not seem to work just comes out as a series of dashes. I have attached a few things that may help. Cheers Allison DIVERSION.lin DIVERSION.shp DIVERSION.shx
-
I need the following code to fillet the pline with a radius of 11 once the pline has been drawn: ;; CONDpl.LSP ;; Copyright ©2019 RS - FFS Tech ;; ;; Author: Roberto Sandoval ;; July 2019 ;; ;; Email: [email protected] ;; ;; ;; This routine draws conduit between two given points from the user ;; and puts it on the 'cond' layer without changing the current layer (Defun CONDINFO () (princ) (prompt "\nCopyright ©2019 RS") (prompt "\n** Draw conduit **") (princ) (setq CMD (getvar "cmdecho")) (setvar "cmdecho" 0) (command "undo" "begin") (graphscr) (setq SP (getpoint "\nStart point of the conduit: ")) (setq XSP (car SP)) (setq YSP (cadr SP)) (setq EP (getpoint SP "\nEnd point of the conduit: ")) (prin1) (setq XEP (car EP)) (setq YEP (cadr EP)) (setq XMP (/ (+ XSP XEP) 2)) (setq YMP (/ (+ YSP YEP) 2)) (setq MP (list XMP YMP)) (setq OSM (getvar "osmode")) (setvar "osmode" 55) (setq old_lay (getvar "clayer")) (command "layer" "set" "Cond" "") ) (defun C:PLF () (command "_PLINE") (while (= 1 (getvar "cmdactive")) (command pause)) (command "._FILLET" "P" "R" 11 "L") (princ) ) (defun RESTORE () (command "layer" "set" old_lay "") (setvar "osmode" OSM) (redraw) (command "undo" "end") (setvar "cmdecho" CMD) (princ) ) (Defun C:CD1 () (CONDINFO) (command "Pline" SP EP "") (RESTORE) ) (Defun C:CD2 () (CONDINFO) (command "Pline" SP ".x" EP SP EP "") (RESTORE) ) (Defun C:CD3 () (CONDINFO) (command "Pline" SP ".y" SP MP ".x" MP EP EP "") (RESTORE) ) (Defun C:CD4 () (CONDINFO) (command "Pline" SP ".x" SP MP ".y" MP EP EP "") (RESTORE) )
-
CHANGE ALL LAYERS TO DEFAULT LINEWEIGHT AUTOCAD LISP
ammobake replied to Efeezy's topic in AutoLISP, Visual LISP & DCL
the new LAYTRANS command would also work (kind of) but only a thing in 2019 or higher. ChriS -
Get VALUE of Attribute in Block and insert in new block
dlanorh replied to tmelancon's topic in AutoLISP, Visual LISP & DCL
Try this. It uses VL to get the the attributes and find the attribute value, and again for setting it in the new block. Minor testing and NO error checking. The title block must be on an unlocked layer. (defun c:bpv ( / ss obj atts) (prompt "\nSelect a Titleblock to be replaced : ") (setq ss (ssget "_+.:E:S:L" '((0 . "INSERT") (66 . 1))) obj (vlax-ename->vla-object (ssname ss 0)) atts (vlax-invoke obj 'getattributes) );end_setq (foreach att atts (if (= (strcase (vlax-get-property att 'tagstring)) "DIMENSION") (setq t_val (vlax-get-property att 'textstring))) );end_foreach (vla-delete obj) (command "-purge" "_A" "*" "_N") (command "-insert" "TITLEBLOCK.DWG" "9,0" "" "" "") (command "explode" "last" "") (setq obj (vlax-ename->vla-object (entlast)) atts (vlax-invoke obj 'getattributes) );end_setq (foreach att atts (if (= (strcase (vlax-get-property att 'tagstring)) "DIMENSION") (vlax-put-property att 'textstring t_val)) );end_foreach (princ) );end_defun -
Get VALUE of Attribute in Block and insert in new block
tmelancon posted a topic in AutoLISP, Visual LISP & DCL
I have a basic routine I run to delete a title block, purge all, then inserts a new title block. The one value I need to retrieve from the old title block to insert in the new title block is "DIMENSION" so I am trying to expand it to do the following: A) prompt user to select which block is to be deleted and replaced B) get the value of attribute tag "DIMENSION" C) delete old block D) purge all E) insert the new block F) populate the new title block attribute "DIMENSION" with the text string or VALUE from the old title block. This is what I currently have, and it works great but I am hoping to expand it to automate the dimension. (defun C:bpv () (princ "\nSelect a Titleblock to be erased and replaced?") (command "erase" PAUSE "") (command "-purge" "all" "" "N") (command "-insert" "TITLEBLOCK.DWG" "9,0" "" "" "" "explode" "last") (PRINC)) Any and all help is tremendously appreciated because I know how busy everyone is. God bless. -
Question about attribute definitions
ammobake replied to ammobake's topic in AutoCAD 2D Drafting, Object Properties & Interface
I tested pasting the masked attdef as a custom property within the sheet set manager, like I mentioned yesterday. I can confirm the masking does indeed work and will insert the masked attdef wherever that specific field calls for the text. Pretty neat. -ChriS -
Offset for each circle center (x,y) from origin and make table
Emmanuel Delay replied to syedmeesamali's topic in AutoLISP, Visual LISP & DCL
I added the Radius . If you want the diameter, then change (rtos radi 2 2) to (rtos (* radi 2.0) 2 2) If you want the volume: (rtos (* pi (* radi radi)) 2 2) And thange the title (list "Core#" "x" "y" "Radius") ;; head ;;;;;;;;;;;;;;;;;;; ;; draw text object (defun Text (pt hgt str color) (entmakex (list (cons 0 "TEXT") (cons 10 pt) (cons 40 hgt) (cons 62 color) (cons 1 str))) ) ;;;;;;;;;;;;;;;;;;; (vl-load-com) (defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space) ;; settings, text height, cel height (setq ht 200) (setq htc 380) ;; document, model space, ... (setq acObj (vlax-get-acad-object) acDoc (vla-get-activedocument acObj) space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace)) ) (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht) )) ;; (vla-SetTextHeight tab 1 ht) (vla-SetTextHeight tab 2 ht) (vla-SetTextHeight tab 4 ht) (setq i 0) (repeat (length lst) ;; iterates the rows (vla-setrowHeight tab i htc) (setq row (nth i lst)) (setq j 0) (repeat (length row) ;; iterates the cols in the row (princ "\n") (princ (nth j row)) (vla-SetText tab i j (nth j row) ) (setq j (+ j 1)) ) (setq i (+ i 1)) ) ;; default Autocad expects a totle row. If the first row has more than 1 cel, let's unmerge this row (if (> (length (nth 0 lst)) 1) (vla-unMergeCells tab 0 0 0 0) ) tab ) ;; Offset for each Circle Center (defun c:occ ( / lst ss bp pt i ip radi) ;; select circles (princ "\nSelect circles then press enter: ") (setq ss (ssget (list (cons 0 "CIRCLE")))) (setq bp (getpoint "\nBase point for offset: ")) (setq pt (getpoint "\nInsert point of the table: ")) ;; make the list (setq lst (list (list "Core#" "x" "y" "Radius") ;; head )) (setq i 0) (repeat (sslength ss) (setq ip (cdr (assoc 10 (entget (ssname ss i))))) ;; circle center (setq radi (cdr (assoc 40 (entget (ssname ss i))))) ;; circle radius (so we know where to put the label) ;; append the list (setq lst (append lst (list (list (+ i 1) ;; 1-based counter, Core# (rtos (car ip) 2 2) ;; 2 decimals, feel free to change this (rtos (cadr ip) 2 2) (rtos radi 2 2) ) ))) (Text (list (+ (nth 0 ip) radi) (- (nth 1 ip) radi) ) 200 (strcat "Core " (itoa (+ i 1))) 160 ;; blue ) (setq i (+ i 1)) ) (inserttable lst pt) ) -
Offset for each circle center (x,y) from origin and make table
dlanorh replied to syedmeesamali's topic in AutoLISP, Visual LISP & DCL
It would help to know if the core sizes are diameters or radii -
Offset for each circle center (x,y) from origin and make table
syedmeesamali replied to syedmeesamali's topic in AutoLISP, Visual LISP & DCL
Just one last request. I also need to add one column to table showing the SIZE of each core. I have only two size i.e. 75mm and 150mm cores. So it will be really helpful if 2nd column is for size in mm and then x and y as usual. -
Hi, I've started using Draftsight 2019. I use the line type Batting as a construction industry standard for cavity wall insulation. I can change the line scale to fill the space but when I go to the layout the scale is wrong and it shows as a massively wide linetype. In AutoCAD I could go to PSLTSCALE and change to 1, then regen all and all would be well. I cant find a command in Draftsight that does the same though. Can anyone help? Its driving me bleeding nuts!
