Search the Community
Showing results for tags 'lisp'.
-
"I'm interested in using Lisp for a project involving rope simulations. Can you recommend a Lisp implementation capable of rendering rope-like curves with realistic physics-based deformations?" bandicam 2024-11-21 13-23-17-231.mp4
-
Hi friends Source:https://www.cadtutor.net/forum/topic/68426-create-automatic-level-in-metric/ (Defun c:BT() (Setq sst(ssget) sset(ssget "p" '((0 . "text"))) tv (cdr(Assoc 1 (Entget(ssname sset 0))))) (command "move" sst "" "@" "@") (setq lset (ssget "p" '((0 . "line")))) (Setq st 1) (while (= 0.0 (ATOF (substr tv st 1))) (Setq st (+ 1 st))) (Setq et 1) (while (/= "\"" (substr tv et 1)) (Setq et (+ 1 et))) (setq str(distof (substr tv st (- et st)))) (command "copy" sset "" (setq a (getpoint "\n Specify the source point: ")) (Setq b(getpoint "\n Specify the Desitnation point: " a))) (if (< (- (cadr a )(cadr b)) 0) (command "change" (entlast) "" "" "" "" "" "" (strcat "EL. "(rtos (+ str (- (cadr B )(cadr A)))4 2)"")) (command "change" (entlast) "" "" "" "" "" "" (strcat "EL. "(rtos (+ str (- (cadr B )(cadr A)))4 2)""))) (command "Copy" lset "" a b) ) I use a command in CAD to mark elevations, and it works well with positive elevation values in imperial units. For example, if I move a marker like 'EL. 1'-0"' up by 2', it correctly updates to 'EL. 3'-0".' However, it doesn't handle negative values as expected. If I move 'EL. -1'-0"' by 2', it changes to EL. -3'-0"' instead of the correct EL. 1'-0". Another example is if I move EL. -5'-0" up by 2', it should update to 'EL. -3'-0",' but instead, it incorrectly changes to EL. -7'-0". Thanks in advance for your help.
-
;crank value based on bar dia only (defun c:Z1 ( / s p a q r below-dia above-dia z cushion k-multiplier) ;; Define bar diameters within the command (setq diameters '((3 . 0.375) (4 . 0.5) (5 . 0.625) (6 . 0.75) (7 . 0.875) (8 . 1.0) (9 . 1.270) (10 . 1.310))) ;; Helper function to get diameter value based on input key (defun get-diameter-value (key) (cdr (assoc key diameters))) ;; Define default values if not previously set (if (not (boundp 'crank:prev-below)) (setq crank:prev-below 8)) (if (not (boundp 'crank:prev-above)) (setq crank:prev-above 4)) (if (not (boundp 'crank:prev-z)) (setq crank:prev-z 0)) ; Length of extension (if (not (boundp 'crank:prev-multiplier)) (setq crank:prev-multiplier 6)) ; Default K multiplier ;; 1. Set the K multiplier (setq k-multiplier (getint (strcat "\nEnter Crank Ratio <" (rtos crank:prev-multiplier 2 0) ">: ")) k-multiplier (if k-multiplier k-multiplier crank:prev-multiplier)) ;; Store the multiplier for future use (setq crank:prev-multiplier k-multiplier) ;; 2. Prompt for below and above level bar numbers (3-10) with previous values as defaults (setq below-dia (getint (strcat "\nSpecify below level bar number (3-10) <" (itoa crank:prev-below) ">: ")) below-dia (if below-dia below-dia crank:prev-below)) (setq above-dia (getint (strcat "\nSpecify above level bar number (3-10) <" (itoa crank:prev-above) ">: ")) above-dia (if above-dia above-dia crank:prev-above)) ;; Display warning if any of the bar diameters is below 5 (if (or (< below-dia 5) (< above-dia 5)) (progn (princ "\nWarning: #5 vert. is minimum for Column.") (princ "\nPlease consult your TL (Team Leader) if bar dia is below 5."))) ;; Store the current values as previous values (setq crank:prev-below below-dia crank:prev-above above-dia) ;; 3. Calculate H and K with cushion value and the user-defined multiplier for K (setq cushion 0.25) (setq crank:prev-y (+ (get-diameter-value below-dia) (get-diameter-value above-dia) cushion)) ; H Distance (setq crank:prev-x (* crank:prev-y k-multiplier)) ; K Distance using multiplier ;; Display current H and K values (print (strcat "*** Calculated H Distance is " (rtos crank:prev-y 2 2) "***")) (print (strcat "*** Calculated K Distance is " (rtos crank:prev-x 2 2) "***")) ;; 4. Get length of extension (setq z (if (= nil (setq z (getreal (strcat "\nSpecify length of extension <" (rtos crank:prev-z 2 2) ">: ")))) crank:prev-z z)) ;; Store the extension value for next time (setq crank:prev-z z) ;; Prompt user for line selection and calculate points (if (and (setq s (entsel "\nSelect line close to end: ")) (setq p (osnap (cadr s) "end")) (setq a (angle (osnap (cadr s) "nea") p)) (setq q (polar (polar p a crank:prev-x) (+ a (/ pi 2)) crank:prev-y)) (setq r (polar q a z))) ;; Create polyline (progn (command "_.pline" "_non" p "_non" q "_non" r "") ;; Join the original line with the new polyline (initcommandversion) (command "_.join" (car s) "_l" ""))) ;; Exit gracefully (princ) ) ;Crank with user given value (defun c:Z2 ( / s p a y x z q r) ;; Define global variables to store previous values (if (not (boundp 'crank:prev-y)) (setq crank:prev-y 0)) (if (not (boundp 'crank:prev-x)) (setq crank:prev-x 0)) (if (not (boundp 'crank:prev-z)) (setq crank:prev-z 0)) ;; Display current values (print (strcat "*** Current H Distance is " (rtos crank:prev-y 4 2) "***")) (print (strcat "*** Current k Distance is " (rtos crank:prev-x 4 2) "***")) (print (strcat "*** Current Length of Extension is " (rtos crank:prev-z 4 2) "***")) ;; Prompt user for line selection (if (and (setq s (entsel "\nSelect line close to end: ")) (setq p (osnap (cadr s) "end")) (setq a (angle (osnap (cadr s) "nea") p)) ;; Get perpendicular distance ;; Use previous value if Enter is pressed (setq y (if (= nil (setq y (getreal (strcat "\nSpecify H distance <" (rtos crank:prev-y 2 2) ">: ")))) crank:prev-y y)) ;; Get tangent distance ;; Use previous value if Enter is pressed (setq x (if (= nil (setq x (getreal (strcat "\nSpecify K distance <" (rtos crank:prev-x 2 2) ">: ")))) crank:prev-x x)) ;; Get length of extension ;; Use previous value if Enter is pressed (setq z (if (= nil (setq z (getreal (strcat "\nSpecify length of extension <" (rtos crank:prev-z 2 2) ">: ")))) crank:prev-z z)) ;; Calculate points (setq q (polar (polar p a x) (+ a (/ pi 2)) y)) (setq r (polar q a z))) ;; Store entered values for next time (progn ;; Only update stored values if new values were provided ;; This ensures we keep the last used values if Enter was pressed. (if (/= y crank:prev-y) (setq crank:prev-y y)) (if (/= x crank:prev-x) (setq crank:prev-x x)) (if (/= z crank:prev-z) (setq crank:prev-z z)) ;; Create polyline (command "_.pline" "_non" p "_non" q "_non" r "") ;; Join the original line with the new polyline (initcommandversion) (command "_.join" (car s) "_l" ""))) ;; Exit gracefully (princ) ) ;bar dia with offset (defun c:Z3 ( / diameters below-dia above-dia h k z offset multiplier cushion p a q r s) ;; Define the bar diameters within the command (setq diameters '((3 . 0.375) (4 . 0.5) (5 . 0.625) (6 . 0.75) (7 . 0.875) (8 . 1.0) (9 . 1.27) (10 . 1.31))) ;; Retrieve previous values or set defaults (if (not (boundp 'crank:prev-multiplier)) (setq crank:prev-multiplier 6)) (if (not (boundp 'crank:prev-below)) (setq crank:prev-below 8)) (if (not (boundp 'crank:prev-above)) (setq crank:prev-above 4)) (if (not (boundp 'crank:prev-offset)) (setq crank:prev-offset 0.0)) (if (not (boundp 'crank:prev-z)) (setq crank:prev-z 36.0)) ;; 1. Prompt for multiplier for K, with previous as default (setq multiplier (getreal (strcat "\nSpecify Crank Ratio <" (rtos crank:prev-multiplier 2 2) ">: ")) multiplier (if multiplier multiplier crank:prev-multiplier)) ;; Store multiplier for future use (setq crank:prev-multiplier multiplier) ;; 2. Prompt for below bar diameter with default (setq below-dia (getint (strcat "\nSpecify below level bar number (3-10) <" (itoa crank:prev-below) ">: ")) below-dia (if below-dia below-dia crank:prev-below)) ;; 3. Prompt for above bar diameter with default (setq above-dia (getint (strcat "\nSpecify above level bar number (3-10) <" (itoa crank:prev-above) ">: ")) above-dia (if above-dia above-dia crank:prev-above)) ;; Display warning if any of the bar diameters is below 5 (if (or (< below-dia 5) (< above-dia 5)) (progn (princ "\nWarning: #5 vert. is minimum for Column.") (princ "\nPlease consult your TL (Team Leader) if bar dia is below 5."))) ;; Store current bar values for next use (setq crank:prev-below below-dia) (setq crank:prev-above above-dia) ;; 4. Get offset value with default (setq offset (getreal (strcat "\nSpecify additional offset for H distance <" (rtos crank:prev-offset 2 2) ">: ")) offset (if offset offset crank:prev-offset)) ;; Store offset for future use (setq crank:prev-offset offset) ;; 5. Get length of extension with default (setq z (getreal (strcat "\nSpecify length of extension <" (rtos crank:prev-z 2 2) ">: ")) z (if z z crank:prev-z)) ;; Store length of extension for next use (setq crank:prev-z z) ;; Calculate H and K values (setq cushion 0.25) (setq h (+ (cdr (assoc below-dia diameters)) (cdr (assoc above-dia diameters)) cushion offset)) (setq k (* h multiplier)) ;; Display calculated H and K values (print (strcat "*** Calculated H Distance is " (rtos h 2 2) "***")) (print (strcat "*** Calculated K Distance is " (rtos k 2 2) "***")) ;; Prompt user for line selection and calculate points (setq s (entsel "\nSelect line close to end: ")) (if (and s (setq p (osnap (cadr s) "end")) (setq a (angle (osnap (cadr s) "nea") p))) (progn ;; Calculate the next two points (setq q (polar (polar p a k) (+ a (/ pi 2)) h)) (setq r (polar q a z)) ;; Create polyline (command "_.pline" "_non" p "_non" q "_non" r "") ;; Join the original line with the new polyline (initcommandversion) (command "_.join" (car s) "_l" "") ) (princ "\nError: No valid line selected.") ) ;; Exit gracefully (princ) ) ;Crank based on Client H and K values (defun c:Z4 ( / s p a q r bar-dia z h-value k-value) ;; Define pre-defined H and K values for each bar diameter (setq diameters '((3 . (0.375 . 2)) (4 . (0.5 . 2.5)) (5 . (0.625 . 3)) (6 . (0.75 . 3.5)) (7 . (0.875 . 4)) (8 . (1.0 . 4.5)) (9 . (1.270 . 5)) (10 . (1.310 . 5.5)))) ;; Helper function to get H and K values based on bar diameter (defun get-h-k-values (key) (cdr (assoc key diameters))) ;; Define default values if not previously set (if (not (boundp 'crank:prev-bar-dia)) (setq crank:prev-bar-dia 8)) ; Default bar diameter ;; Prompt for bar diameter (3-10) with the previous value as the default (setq bar-dia (getint (strcat "\nSpecify bar diameter (3-10) <" (itoa crank:prev-bar-dia) ">: ")) bar-dia (if bar-dia bar-dia crank:prev-bar-dia)) ;; Store the bar diameter for future use (setq crank:prev-bar-dia bar-dia) ;; Get H and K values based on the selected bar diameter (setq h-value (car (get-h-k-values bar-dia))) ; H value for the selected diameter (setq k-value (cdr (get-h-k-values bar-dia))) ; K value for the selected diameter ;; Display the calculated H and K values (print (strcat "*** Calculated H Distance for bar diameter " (itoa bar-dia) " is " (rtos h-value 2 2) "***")) (print (strcat "*** Calculated K Distance for bar diameter " (itoa bar-dia) " is " (rtos k-value 2 2) "***")) ;; Get length of extension (setq z (if (= nil (setq z (getreal (strcat "\nSpecify length of extension <" (rtos crank:prev-z 2 2) ">: ")))) crank:prev-z z)) ;; Store the extension value for future use (setq crank:prev-z z) ;; Prompt user for line selection and calculate points (if (and (setq s (entsel "\nSelect line close to end: ")) (setq p (osnap (cadr s) "end")) (setq a (angle (osnap (cadr s) "nea") p)) (setq q (polar (polar p a k-value) (+ a (/ pi 2)) h-value)) (setq r (polar q a z))) ;; Create polyline (progn (command "_.pline" "_non" p "_non" q "_non" r "") ;; Join the original line with the new polyline (initcommandversion) (command "_.join" (car s) "_l" ""))) ;; Exit gracefully (princ) ) Hi every friends Base code Source: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/req-polyline-crank/td-p/11808942 I could really use some help or suggestions. I'm currently using multiple commands to draw a crank bar, but I’d like to combine all those commands into one single command. I’ve seen how Lee Mac does it with his ATC command, and I’m hoping to achieve something similar. If you have any ideas on how I can do this, please share! Also, if you have suggestions for alternatives other than just combining all the commands, I’d love to hear those too. Thanks in advance to all.
-
Hello everyone. This is my first time posting but i have enjoyed a lot of your great work. I use a lot a field about object/polyline/length - decimal 0 (copy it to different polylines and than get their lenghth) and i am tired of changing object from dialogbox. Is there an easy way (lisp or other) to change the object directly and get its length:):)
-
Text entities process with green selection window
harimaddddy posted a topic in AutoLISP, Visual LISP & DCL
Hi all, I need some help from pros, but my English is not good . I'm use this 1 command to align the text with custom insertion point and evenly distributed, the issues are listed below, 1. When I select the text entities with green window (snap-1) it reorder all text entities by itself (snap-2), I might select a group of texts labeled 5 to 7 first, then select another group from 1 to 4, and finally include text labeled 8. However, when I look at the selection afterward, the order is not what I expected (snap-2); it seems to rearrange itself instead of keeping the sequence I selected them in. Snap:1 Snap-2 2.If i use undo it affect the osmode , so that i use a error handler. Thanks in advance.... (defun c:1() (command "ucs" "world") (setq objs (ssget '((0 . "TEXT")))) (Setq scalef (/ (cdr(assoc 40(entget(ssname objs 0))))9)) (setq x_x (* scalef 4.0)) (setq y_y (* scalef 4.0)) (setq text_gap (* scalef 16.0)) (setq text_height (* scalef 9.0)) (setq ss_len (sslength objs)) (setq osm (getvar "osmode")) (command "osnap" "end") (setq cxy (getpoint "pick a point")) (command "osmode" 0) (setq cx (car cxy)) (setq cy (car (cdr cxy))) (setq count 0) (setvar "osmode" 16383) (repeat ss_len (if (= count 0) (progn (setq tx1 (+ cx x_x)) (setq ty1 (+ cy (/ (+ (* (- ss_len 1.0) text_gap) text_height) 2 ) ) ) (setq tx2 tx1) (setq ty2 (- ty1 text_height)) ) (setq ty2 (- ty2 text_gap)) ) (setvar "osmode" 16383) (setq obj (ssname objs count)) (setq objp (entget obj)) (setq objj_new (cons 72 0)) (setq objc_11 (cons 11 (list 0 0 0))) (setq objc_10 (cons 10 (list tx2 ty2 0))) (setq objp (subst objc_10 (assoc 10 objp) objp)) (setq objp (subst objc_11 (assoc 11 objp) objp)) (setq objp (subst objj_new (assoc 72 objp) objp)) (entmod objp) (setq count (+ count 1)) ) (setvar "osmode" 16383) (setq lpx1 (+ cx (* 12.0 SCALEF))) (setq lpx2 cx) (setq lpx3 cx) (setq lpx4 lpx1) (setq lpy1 (+ ty1 x_x)) (setq lpy2 lpy1) (setq lpy3 (- ty1 (+ (+ (* text_gap (- count 1)) text_height) (* scalef 5.0)) ) ) (setq lpy4 lpy3) (setq lp1 (list lpx1 lpy1)) (setq lp2 (list lpx2 lpy2)) (setq lp3 (list lpx3 lpy3)) (setq lp4 (list lpx4 lpy4)) (setq clay (getvar "clayer")) (setvar "clayer" "0-25text") (if(> ss_len 1) (progn (command "pline" lp1 lp2 lp3 lp4 "") ) ) (setvar "osmode" 16383) (setvar "clayer" clay) ) -
Create field from attribute in block and put it directly into dimension.
fromMlm posted a topic in AutoLISP, Visual LISP & DCL
Hi all, Again I have found a lisp Lee Mac made that copies a field into a dimension, "copyfield", but it requires that the field already exists... So is there a way to create a field from an attribute in a block and then insert the field directly into a dimension? Thanks in advance. -
Is There Any Way To Export All Layers Separately Into Pdf Format?
Shahtaj Bhutto posted a topic in Tutorials & Tips'n'Tricks
Hi Is there any way to export all layers separately into pdf format? i want to export all of them at once to edit them in illustrator. It's taking alot of time to export them one by one from autocad I don't have any professional Experience with programming but i have tried to made this .lisp with chatGPT but it's not working to export files which property in codes needs improvements please (defun c:ExportLayersToPDF (\Users\Useer\Desktop\pdf layers) (setq dwgname "EMERALD HILLS MP (2007) 25 01 2023") ; (setq dwgpath "F:\Shahtaj Ahmed Bhutto\AUTOCAD") ; (setq layname "") (while (setq layname (tblnext "LAYER" layname)) (and layname (/= layname "0") (/= layname "DEFPOINTS") (/= (logand (cdr (assoc 70 (tblsearch "LAYER" layname))) 1) 1) (progn (setq pdfname (strcat dwgname "_" layname ".PDF")) (setq pdffullpath (strcat dwgpath pdfname)) (command "-plot" "Yes" "Model" "" "" "DWG To PDF.pc3" "A0" "PORTRAIT" "Inches" "Fit" "Center" "No" "No" "No" "Yes" "No" "No" "Yes" "Yes" pdffullpath) T ) ) ) (princ) )- 10 replies
-
Dear members Can please add Additional code for Road marking chevron starting interval nd fix/continue interval , start base point. By layer, chev solid I will be very thankful to you Thanks Lisp program and image attached CHEVERON MARKING.lsp
-
Hello good afternoon, First of all, I apologize but I don't have any kind of training in programming and I try to get by with the tools I have at my disposal (forums, YouTube, AI,...) I am a topographic engineer and I needed a lisp that would draw the grid the way I wanted, I have already developed much of it using the methods mentioned above but now I am stuck in creating the coordinate text. According to my analysis, it must be the justification of the text, I say this because even doing an isolated test on the creation of the text (entmake) the justification remains by default. The following image is a representation of the final result. I'll leave my humble lines of code attached so that a kind soul can help me Thank you for taking the time to read the post Grid__.lsp
-
I have difficult time finding a command that would match a block's attribute (text height, text rotation, and text scale) with a source block. I had found a LISP routine that would match the block itself with a source block but it did not include attributes. I don't need to match attibute values, just the properties. I'm using AutoCAD 2012 with regular blocks (not dynamic)
-
Revision cloud lisp with custom rotation of revision block on temporarily layer
fromMlm posted a topic in AutoLISP, Visual LISP & DCL
I found this nice revision cloud lisp made by Lee Mac: (defun c:rv ( / *error* ar bn cm el fn rv ) (setq bn "revlsp") ;; Rev Cloud Attributed Block (defun *error* ( msg ) (if cm (setvar 'cmdecho cm)) (if ar (setvar 'attreq ar)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) (setq cm (getvar 'cmdecho) ar (getvar 'attreq) ) (cond ( (not (or (tblsearch "BLOCK" bn) (and (setq fn (findfile (strcat bn ".dwg"))) (progn (setvar 'cmdecho 0) (command "_.-insert" fn nil) (setvar 'cmdecho cm) (tblsearch "BLOCK" bn) ) ) ) ) (princ (strcat "\n" bn ".dwg not found.")) ) ( (zerop (logand 2 (cdr (assoc 70 (tblsearch "BLOCK" bn))))) (princ (strcat "\n" bn " not attributed.")) ) ( (setq *rev* (cond ( (= "" (setq rv (getstring t (strcat "\nSpecify Revision" (if *rev* (strcat " <" *rev* ">: ") ": "))))) *rev* ) ( rv ) ) ) (initcommandversion) (command-s "_.revcloud") (while (= 1 (logand 1 (getvar 'cmdactive))) (command "\\")) (setvar 'cmdecho 0) (setvar 'attreq 0) (setq el (entlast)) (command "_.-insert" bn "_S" 1.0 "_R" 0.0 "\\") (if (not (eq el (setq el (entlast)))) (progn (setq el (entget (entnext el))) (if (entmod (subst (cons 1 *rev*) (assoc 1 el) el)) (entupd (cdr (assoc -1 el))) ) ) ) (setvar 'attreq ar) (setvar 'cmdecho cm) ) ) (princ) ) (princ) What I wish to do is: 1. Set the insertion point with variable rotation using osnap nearest and then back to current osnaps 2. - Save current layer/working layer. - Then temporarily change to a new given layer but change colour on the revision cloud to cyan (not the block) - Do the revision cloud and the insert. - Finally change back to my working layer. (in my case "K596 - Revideringsmoln") REVLSP.dwg I have tried to delete the 0.0 (command "_.-insert" bn "_S" 1.0 "_R" "\\") It just allows me to rotate the block and then place it. And the revision do not show. I would like to place first and then rotate. How do I specify the insert point for the block so I can rotate it? -
find the dimension and polyline distance using AUTOLISP
keku posted a topic in AutoLISP, Visual LISP & DCL
I'm new to Lisp and trying calculate the distance from a wall to a polygon box, as well as the distance between two polygon boxes. Additionally, I need to determine the dimensions of both the polygon box and the wall. I'm using Lee Mac's dimensioning code as a reference and trying to modify it to achieve these calculations.can i get this type of outcome using lisp -
Hello everyone I need a Lisp that converts the contents of one or more separate texts (not MTEXT) to another text. Suppose that there are discrete texts in different places of the layout, for example, apple, orange, banana, lemon. I need a lisp that after typing the command, I do the first right click on the apple, and by doing the rest of the right clicks on other fruits, they turn into apples. Thank you for your help.
-
Set MLeader to Existing MLeader Style via LISP
parkerdepriest posted a topic in AutoLISP, Visual LISP & DCL
Hello, I am trying to create a lisp routine that sets all existing MLEADERs to a certain pre-set MLEADERSTYLE, the equivalent of doing a Quick Select for Mleaders, and setting the style under the properties window. I was able to write a similar routine that selects all dimensions and sets them to a certain DIMSTYLE, using entmod and DXF code 3 for dimstyle. So far, I have not been able to find a group code for MLEADERSTYLE Any help would be greatly appreciated! (defun C:dimstylechange (/ ENTITIES NO_OF_ENTITIES SSPOSITION ENTITY_NAME OLD_ENTLIST NEW_STYLE NEW_ENTLIST) (setvar "CMDECHO" 0) (setq ENTITIES (ssget "X" '((0 . "DIMENSION")))) (setq NO_OF_ENTITIES (sslength ENTITIES)) (setq SSPOSITION 0) (repeat NO_OF_ENTITIES ;***CHANGE STYLE*** (setq ENTITY_NAME (ssname ENTITIES SSPOSITION)) (setq OLD_ENTLIST (entget ENTITY_NAME)) (setq OLD_STYLE (assoc 3 OLD_ENTLIST)) (setq NEW_STYLE (cons 3 "BCR 11x17")) (setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST)) (entmod NEW_ENTLIST) ;***CHANGE LAYER*** (setq OLD_ENTLIST (entget ENTITY_NAME)) (setq OLD_STYLE (assoc 8 OLD_ENTLIST)) (setq NEW_STYLE (cons 8 "DIM")) (setq NEW_ENTLIST (subst NEW_STYLE OLD_STYLE OLD_ENTLIST)) (entmod NEW_ENTLIST) (setq SSPOSITION (1+ SSPOSITION)) ) (command ".CHPROP" ENTITIES "" "C" "BYLAYER" "LT" "BYLAYER" "") (princ (strcat "\n..." (rtos NO_OF_ENTITIES 2 0) " Dimension(s) changed...")) (setvar "CMDECHO" 1) (princ) ) dimstylechange.LSP -
Lisp to sequentially fill in attributes based on selection
PrimeTimeAction posted a topic in AutoLISP, Visual LISP & DCL
I have drawing with a bunch of blocks with attributes tags. Among the attribute tags the following three are of importance: ID Next Previous The ID attribute values are already entered in the blocks and are unique. I would like to have a lisp that will enable me to sequentially pick the blocks and fill in the Next and Previous attributes tags with the ID values. Attached is sample file showing the starting point and expected end result. Any ideas how to go about making this lisp? EDIT: I have been able to modify a lisp from @Lee Mac as fist step. But it only works in forward direction i.e to fill in Previous attribute. Im thinking that to get the functionality to fill in "Next", we cannot use single item selection, we will have to use list selection to get the iD of next block and fill in the current block in "Next" Attribute. So the operation sequence will be Start lisp> Click all blocks one by one> hit Enter Any help in achieving this will be welcome. (defun c:ca ( / _SelectBlockWithTag a b des src tag ) (vl-load-com) (setq src "ID" ; Source Attribute Tag des "Previous" ; Destination Attribute Tag ) (defun _SelectBlockWithTag ( tag / e a ) (setq tag (strcase tag)) (while (progn (setvar 'ERRNO 0) (setq e (car (entsel (strcat "\nSelect Block with attribute " tag ": ")))) (cond ( (= 7 (getvar 'ERRNO)) (princ "\nMissed, Try Again.") ) ( (not e) nil ) ( (and (eq "INSERT" (cdr (assoc 0 (entget e)))) (= 1 (cdr (assoc 66 (entget e)))) ) (if (not (setq a (vl-some (function (lambda ( x ) (if (eq tag (strcase (vla-get-tagstring x))) x) ) ) (vlax-invoke (vlax-ename->vla-object e) 'getattributes) ) ) ) (princ (strcat "\nBlock does not contain tag " tag ".")) ) ) ( (princ "\nInvalid Object Selected.") ) ) ) ) a ) (while (and (setq a (_SelectBlockWithTag src)) (setq b (_SelectBlockWithTag des)) ) (vla-put-textstring b (vla-get-textstring a)) ) (princ) ) SampleDrwaing.dwg -
I am looking for a routine to sort contour lines. I am using 3d polylines that I import from Global Mapper. My problem is all of the lines are on one layer. Ideally, I would like to pick a starting elevation (polyline) and have the routine select every 5th contour up and down. Once then are all selected, I can move them to a new layer (like TOPO-INDEX). Some of these sites are hundreds of acres and have significant elevation changes. To do this by hand is VERY time-consuming (and easy to miss some contours). I am not a programmer, but this seems like the type of task that is ideal for a lisp routine. Any help is appreciated.
-
Hi guys, I've been trying to figure out a way to insert a new block in a project that already has one with the same name. I would like to have something asking me if I want to keep the old one or replace/overwrite with the new one. Keeping the placement of the old block in the project. I know that AutoCAD keeps the old version on a block if it has the same name as the new one, having to remove all instance of the block and purge all. Why wouldn't AutoCAD asked me ; [There is a block with the same name in your project, Would you like to; Overwrite, Rename, Cancel] Just like in file explorer on desktop. Anyway, maybe I'm asking to much let me know guys if you have a suggestion, either a LISP or a command that I'm not aware of yet in AutoCAD.. Thanks
- 1 reply
-
- block name
- overwrite
-
(and 1 more)
Tagged with:
-
Hi guys, Im new here and i've been searching and even asking chatgpt to help me out but it doesnt seem to work properly. Im working on a SLD (Single Line Diagram) for an electrical project and when wires cross on the diagram, it needs to have a gap on one of the 2 lines. I've tried this lisp command that ChatGPT gave me but with little to no success; (defun c:BreakAndShorten ( / pt line break_length startpt1 endpt1 startpt2 endpt2) (setq break_length 2.5) ; Set your desired shorten length here (2.5 mm in this case) (setq line (car (entsel "\nSelect the line to break: "))) (setq pt (getpoint "\nSelect the break point: ")) (if (and line pt) (progn (setq startpt1 (polar pt (angle pt (vlax-curve-getStartPoint line)) (- break_length))) (setq endpt1 pt) (setq startpt2 pt) (setq endpt2 (polar pt (angle pt (vlax-curve-getEndPoint line)) break_length)) (command "BREAK" line startpt1 endpt2) (setq line1 (car (entsel "\nSelect the first segment to shorten: "))) (setq line2 (car (entsel "\nSelect the second segment to shorten: "))) (if line1 (command "LENGTHEN" "DE" (- break_length) line1)) (if line2 (command "LENGTHEN" "DE" (- break_length) line2)) ) (alert "You must select a line and a break point.") ) (princ) ) In sum, I want to break one line at a point and then shorten the 2 segments by 2.5mm so it has a 5mm gap without using multiple command everytime
-
Help with Polyline Lisp (Export All Lengths to Table)
gordon_Gjs posted a topic in AutoLISP, Visual LISP & DCL
Hello, I am searching for a lisp that can export the lengths of all selected polylines and export them to either Excel or an AutoCad table. I have found and tested around 20 lisps but so far cannot find the right one. There were only 2 that look promising, maybe they could be modified? One was by Lee Mac and the other Jimmy Bergmark. I can post the 2 Lisp if needed. The lisp would need to have you select multiple polylines and give the total lengths of each polyline in the order that they were selected in. Then the data would either appear on an AutoCad table or Excel. Thanks for any help that can be provided. -
lisp Select polylines between two selected blocks.
srikanth_0126 posted a topic in AutoLISP, Visual LISP & DCL
Hi, i have multiple polylines in a series and block are placed on them. i want to select the polylines between two selected blocks. sample file is attached. Thanks, Srikanth select_between _two_blocks_sample.dwg -
Remove a section of text in a text file from between 2 keywords with autolisp or visual lisp
Mr Bojangles posted a topic in AutoLISP, Visual LISP & DCL
Hi guys I'm not sure that this is possible but hey you guys know a hell of a lot and surprise me often. Is it possible in lisp to look inside a text file and remove some text from between 2 keywords? For example The text filename would be the same as the cad file, but it's on another network location. I can create a variable that concatenates the file name and location. This I know I can do lol. Then I want the lisp to open the file find Keyword1 and keyword2 (always the same and only ever 1 of each in the file, also there would always be text before and after the keywords which should be kept intact). Then remove any text that lies between them. And finally resave the file. I've done some searches but I keep getting results for editing text inside of cad, which isn't what I'm after, or recommending using other programming language, but I've no idea how to do that. Which is why I'm pinning my hopes on this.- 29 replies
-
Hello everyone, I'm wondering if it is possible to create a lisp that could attach several images to AutoCAD 2010 at the same time and create a new layer that has the same name like an image for each image. I downloaded georefimg app that put an image in certain place in AutoCAD based on world file but it is necessary to do this for each image separately. In case of this app first thing to do is attach one image to CAD and afterwards I can use georefimg to choose an image (that was inserted before) in order to put this in proper section. But it could be faster and more efficient if I would attach many images equally in random place and after that use this georefimg for all images. If someone has some idea how to prepare sth like this I'll be grateful for any suggestions in this case. Best wishes, Jakub
- 17 replies
-
- app
- georeference
-
(and 2 more)
Tagged with:
-
Can anyone help me to write a code ?? Which Identifies each closed polyline (rectangle) on the "ss-bor" layer. Finds the text entity (content) of text on the "ss-pre" layer which is within (rectangle) on the "ss-bor" layer . Selects all entities on the "ss-part" layer within the (rectangle) on the "ss-bor" layer. Creates a block using the text value from the "ss-pre" layer as the block name, including all selected entities from the "ss-part" layer within the (rectangle) on the "ss-bor" layer. and loop though each (rectangle) on the "ss-bor" layer and make block of each as above mentioned.. For information i have attached my dwg file G27.dwg
-
List variables to block attributes with lisp
Kris Malen posted a topic in AutoLISP, Visual LISP & DCL
Can someone help me out with changing the attributes of a block using a list. The block is used in a leader. The block has 7 attributes, but my list doesn't always contain 7 variables. I have tried to implement Lee Mac's code dynamicblockfunctions, but I keep getting the error "too few arguments". I would like to import the leader when the calculation is done, and for the block to then automatically change the attributes to the variables in the list. Here's my current code: (defun c:testKRIS ( / *error* dch dcl des mv d1 d2 d3 d4 d5 d6) (defun *error* ( msg ) (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch) ) (if (= 'file (type des)) (close des) ) (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl) ) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (cond ( (not (setq dcl (vl-filename-mktemp nil nil ".dcl") des (open dcl "w") ) ) (princ "\nUnable to open DCL for writing.") ) ( (progn (foreach str '( "ed : edit_box" "{" " alignment = left;" " width = 20;" " edit_width = 10;" " fixed_width = true;" "}" "" "test : dialog" "{" " spacer;" " key = \"dcl\";" " : ed" " {" " key = \"mv\";" " label = \"MV:\";" " }" " :boxed_column { " " label = \"Diepte vd buizen\";" " :row {" " : ed" " {" " key = \"d1\";" " label = \"A:\";" " }" " : ed" " {" " key = \"d4\";" " label = \"X:\";" " }}" " :row {" " : ed" " {" " key = \"d2\";" " label = \"B:\";" " }" " : ed" " {" " key = \"d5\";" " label = \"Y:\";" " }}" " :row {" " : ed" " {" " key = \"d3\";" " label = \"C:\";" " }" " : ed" " {" " key = \"d6\";" " label = \"Z:\";" " }}" " }" " : boxed_row" " { " " label = \"BOK berekeningen\";" " :column {" " : ed { key = \"res\"; label = \"BOK:\"; is_enabled = false; }" " : ed { key = \"res2\"; label = \"BOK2:\"; is_enabled = false; }" " : ed { key = \"res3\"; label = \"BOK3:\"; is_enabled = false; }" " }" " :column{" " : ed { key = \"res4\"; label = \"BOK4:\"; is_enabled = false; }" " : ed { key = \"res5\"; label = \"BOK5:\"; is_enabled = false; }" " : ed { key = \"res6\"; label = \"BOK6:\"; is_enabled = false; }" " }" " }" " : button" " {" " key = \"cal\";" " label = \"Calculate\";" " }" " spacer;" " ok_only;" "}" ) (write-line str des) ) (setq des (close des) dch (load_dialog dcl) ) (<= dch 0) ) (princ "\nUnable to load DCL file.") ) ( (not (new_dialog "test" dch)) (princ "\nUnable to display 'test' dialog.") ) ( t (set_tile "dcl" "Calculate Area") (action_tile "mv" "(setq mv $value)") (action_tile "d1" "(setq d1 $value)") (action_tile "d2" "(setq d2 $value)") (action_tile "d3" "(setq d3 $value)") (action_tile "d4" "(setq d4 $value)") (action_tile "d5" "(setq d5 $value)") (action_tile "d6" "(setq d6 $value)") (action_tile "cal" (vl-prin1-to-string '( (lambda ( / m x y z a b c lijst_results ) (setq lijst_results '()) (set_tile "res" "") (set_tile "res2" "") (set_tile "res3" "") (set_tile "res4" "") (set_tile "res5" "") (set_tile "res6" "") (setq m (distof mv)) (if m (progn (setq lijst_results (append lijst_results (list (strcat "mv: " (rtos m 2 2))))) (if (and d1 (setq a (distof d1))) (progn (setq lijst_results (append lijst_results (list (strcat "A: " (rtos (- m a) 2 2))))) (set_tile "res" (rtos (- m a) 2 2)))) (if (and d2 (setq b (distof d2))) (progn (setq lijst_results (append lijst_results (list (strcat "B: " (rtos (- m b) 2 2))))) (set_tile "res2" (rtos (- m b) 2 2)))) (if (and d3 (setq c (distof d3))) (progn (setq lijst_results (append lijst_results (list (strcat "C: " (rtos (- m c) 2 2))))) (set_tile "res3" (rtos (- m c) 2 2)))) (if (and d4 (setq x (distof d4))) (progn (setq lijst_results (append lijst_results (list (strcat "X: " (rtos (- m x) 2 2))))) (set_tile "res4" (rtos (- m x) 2 2)))) (if (and d5 (setq y (distof d5))) (progn (setq lijst_results (append lijst_results (list (strcat "Y: " (rtos (- m y) 2 2))))) (set_tile "res5" (rtos (- m y) 2 2)))) (if (and d6 (setq z (distof d6))) (progn (setq lijst_results (append lijst_results (list (strcat "Z: " (rtos (- m z) 2 2))))) (set_tile "res6" (rtos (- m z) 2 2)))) (print lijst_results) ) (alert "Vul maaiveld waarden in.") ) ) ) ) ) (start_dialog) ) ) (*error* nil) (princ) ) -
Change values of dynamic block with outcomes
Kris Malen posted a topic in AutoLISP, Visual LISP & DCL
I want to change the values of a dynamic block within a lisp. This lisp contains a calculation. I used .dcl for this. My dynamic block has 7 attributes: maaiveld, HOOGTE1, HOOGTE2, HOOGTE3, HOOGTE4, HOOGTE5 and HOOGTE6. My lisp code has 7 values: m, a, b, c, x, y and z The order of these outputs are important. a, b, and c are sewer pipes that arrive in the cewer, and x, y, and z are pipes that depart from the sewer pit. So if there are only 2 pipes, we only have to use a and x. This makes it difficult. I can't just set HOOGTE1 to a, HOOGTE2 to b, HOOGTE3 to c, etc. If I do it this way, it will leave a gap in my leader. I hope this is even possible. I provided some screenshots of my calculator and of the leader, and the problem of the gap. Maybe I just need to create a more complex dynamic block, so that I can just connect the hoogte1,2,3,... to a,b,c,... I really don't know. code: (defun c:testKRIS ( / *error* dch dcl des mv d1 d2 d3 d4 d5 d6) (defun *error* ( msg ) (if (and (= 'int (type dch)) (< 0 dch)) (unload_dialog dch) ) (if (= 'file (type des)) (close des) ) (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl) ) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (cond ( (not (setq dcl (vl-filename-mktemp nil nil ".dcl") des (open dcl "w") ) ) (princ "\nUnable to open DCL for writing.") ) ( (progn (foreach str '( "ed : edit_box" "{" " alignment = left;" " width = 20;" " edit_width = 10;" " fixed_width = true;" "}" "" "test : dialog" "{" " spacer;" " key = \"dcl\";" " : ed" " {" " key = \"mv\";" " label = \"MV:\";" " }" " :boxed_column { " " label = \"Diepte vd buizen\";" " :row {" " : ed" " {" " key = \"d1\";" " label = \"A:\";" " }" " : ed" " {" " key = \"d4\";" " label = \"X:\";" " }}" " :row {" " : ed" " {" " key = \"d2\";" " label = \"B:\";" " }" " : ed" " {" " key = \"d5\";" " label = \"Y:\";" " }}" " :row {" " : ed" " {" " key = \"d3\";" " label = \"C:\";" " }" " : ed" " {" " key = \"d6\";" " label = \"Z:\";" " }}" " }" " : boxed_row" " { " " label = \"BOK berekeningen\";" " :column {" " : ed { key = \"res\"; label = \"BOK:\"; is_enabled = false; }" " : ed { key = \"res2\"; label = \"BOK2:\"; is_enabled = false; }" " : ed { key = \"res3\"; label = \"BOK3:\"; is_enabled = false; }" " }" " :column{" " : ed { key = \"res4\"; label = \"BOK4:\"; is_enabled = false; }" " : ed { key = \"res5\"; label = \"BOK5:\"; is_enabled = false; }" " : ed { key = \"res6\"; label = \"BOK6:\"; is_enabled = false; }" " }" " }" " : button" " {" " key = \"cal\";" " label = \"Calculate\";" " }" " spacer;" " ok_only;" "}" ) (write-line str des) ) (setq des (close des) dch (load_dialog dcl) ) (<= dch 0) ) (princ "\nUnable to load DCL file.") ) ( (not (new_dialog "test" dch)) (princ "\nUnable to display 'test' dialog.") ) ( t (set_tile "dcl" "Calculate Area") (action_tile "mv" "(setq mv $value)") (action_tile "d1" "(setq d1 $value)") (action_tile "d2" "(setq d2 $value)") (action_tile "d3" "(setq d3 $value)") (action_tile "d4" "(setq d4 $value)") (action_tile "d5" "(setq d5 $value)") (action_tile "d6" "(setq d6 $value)") (action_tile "cal" (vl-prin1-to-string '( (lambda ( / m x y z a b c ) (set_tile "res" "") (set_tile "res2" "") (set_tile "res3" "") (set_tile "res4" "") (set_tile "res5" "") (set_tile "res6" "") (cond ( (or (not mv) (= "" mv)) (alert "Please enter a maaiveld value.") (mode_tile "mv" 2) ) ( (or (not d1) (= "" d1)) (alert "Please enter a A value.") (mode_tile "d1" 2) ) ( (or (not d2) (= "" d2)) (alert "Please enter a B value.") (mode_tile "d2" 2) ) ( (or (not d3) (= "" d3)) (alert "Please enter a C value.") (mode_tile "d3" 2) ) ( (or (not d4) (= "" d4)) (alert "Please enter a X value.") (mode_tile "d4" 2) ) ( (or (not d5) (= "" d5)) (alert "Please enter a Y value.") (mode_tile "d5" 2) ) ( (or (not d6) (= "" d6)) (alert "Please enter a Z value.") (mode_tile "d6" 2) ) ( (not (setq m (distof mv))) (alert "Het Maaiveld moet een getal zijn.") (mode_tile "mv" 2) ) ( (not (setq a (distof d1))) (alert "The A must be numerical.") (mode_tile "d1" 2) ) ( (not (setq b (distof d2))) (alert "The B must be numerical.") (mode_tile "d2" 2) ) ( (not (setq c (distof d3))) (alert "Het C moet een getal zijn.") (mode_tile "d3" 2) ) ( (not (setq x (distof d4))) (alert "The X must be numerical.") (mode_tile "d4" 2) ) ( (not (setq y (distof d5))) (alert "The Y must be numerical.") (mode_tile "d5" 2) ) ( (not (setq z (distof d6))) (alert "The Z must be numerical.") (mode_tile "d6" 2) ) ( (<= m 0.0) (alert "Het maaiveld moet groter dan nul zijn.") (mode_tile "mv" 2) ) ( (<= a 0.0) (alert "The A must be greater than zero.") (mode_tile "d1" 2) ) ( (<= b 0.0) (alert "The B must be greater than zero.") (mode_tile "d2" 2) ) ( (<= c 0.0) (alert "Het C moet groter dan nul zijn.") (mode_tile "d3" 2) ) ( (<= x 0.0) (alert "The X must be greater than zero.") (mode_tile "d4" 2) ) ( (<= y 0.0) (alert "The Y must be greater than zero.") (mode_tile "d5" 2) ) ( (<= z 0.0) (alert "The Z must be greater than zero.") (mode_tile "d6" 2) ) (t (set_tile "res" (rtos (- m a) 2)) (set_tile "res2" (rtos (- m b) 2)) (set_tile "res3" (rtos (- m c) 2)) (set_tile "res4" (rtos (- m x) 2)) (set_tile "res5" (rtos (- m y) 2)) (set_tile "res6" (rtos (- m z) 2)) ) ) ) ) ) ) (start_dialog) ) ) (*error* nil) (princ) ) The code needs work to be visually better, but I want it to work before I do that.- 6 replies
-
- dynamicblocks
- lisp
-
(and 2 more)
Tagged with: