Search the Community
Showing results for tags 'lisp'.
-
Dear sir, I need a program for to draw hatching as per condition, multiple selection at time. If separate, separate lisp no issue, if add option for 2 line and 3line Cad file attached with situation and require solution. Thanks HATCHING PATTERN AS PER CONDITION.dwg
-
The current routine works but requires 2 major changes (1) and (2). So... basically what I would like to accomplish would be: 1) find a way so that the filtering process accounts for a specific block throughout the drawing instead of :L , but no success on this regard: (if (setq s (ssget "_X" '((0 . "INSERT") (66 . 1) (2 . "`*U*,POTEAUX_PLAN_BLK1")))) (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (setq ent (ssname s (setq i (1- i)))))) (if (and (vlax-property-available-p o 'effectivename) (= "poteaux_plan_blk1" (strcase (vla-get-effectivename o) t)) ) (progn ... It works as is, but cannot find a way to incorporate (2 . "`*U*,POTEAUX_PLAN_BLK1") for the dynamic block "POTEAUX_PLAN_BLK1". So I ended up selecting the blocks one by one as an alternative. 2) The attributes on the block are arranged in the same manner as displayed on the tags list. Is it possible to move tags downward by say 2.5 units to re-arrange the position after tags are removed (Photo before & after)? (defun c:foo (/ s tags) ;; List of tags to target (setq tags '( "ENDOMAGÉ" "FISSURÉ" "BANDEJAUNE" "COUPÉ" "TRANSFERT" "<1M" "<3M" "INC.+5" ) ) ;; Select attributed blocks (if (setq s (ssget ":L" '((0 . "INSERT") (66 . 1)))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) ; Loop through selected entities (foreach tag tags (if (vl-catch-all-error-p (vl-catch-all-apply (function (lambda () ;; Get the current value of the attribute (cond ;; Case 1: Empty or "NON" -> Set value to "" ((or (eq "" (getpropertyvalue e tag)) (eq "NON" (strcase (getpropertyvalue e tag)))) (setpropertyvalue e tag "")) ;; Case 2: "OUI" -> Set value to the tag name ((eq "OUI" (strcase (getpropertyvalue e tag))) (setpropertyvalue e tag tag)) ) ) ) ) ) (princ (strcat "\nError handling tag: " tag)) ; Error Handling );end if ) ) ); end if (princ) ); end defun Any help is appropriated! Before... After... my wish...
-
Hello, I found a lisp made by third parties and I wanted to adapt it, tried to make the changes myself, but the lisp doesn't work at all. The original lisp (VPGRID.lsp) creates a coordinate grid when selecting the viewport, however the coordinate labels come with the E/N suffix and I want the "X="/"Y=" prefix. (Line 258 and line 318 from original code) I would also like to be able to choose the size of the lines and text (Variables "gr_btick", "gr_ctick" and "gr_txthgt"). I tried to make the changes (QUADRICULA_VP.lsp) without success. Can someone help me. vpgrid.lsp QUADRICULA_VP.lsp
-
Replacing an extrusion profile with another profile
Dan Kitchens posted a topic in AutoCAD 3D Modelling & Rendering
A while back AutoCAD introduced semi-parametric extrusions, you could alter the polyline and the extrusion would update. It's a great feature, but has anyone heard of a way of replacing the polyline profile with a different one? This would be very handy for cabinetmakers who use a variety of profiles to their doors. It's a shame 2D blocks can't be extruded as blocks can be replaced...- 14 replies
-
- lisp
- 3d modelling
-
(and 3 more)
Tagged with:
-
I got this code from chatgpt, that chatgpt got from a defunct post from autocad website forums. Whenever I tried going to the website or googling, the link seems broken so I don't know how this code exactly works. I am trying to make a Lisp that creates dimstyles from scratch. everything is working except for changing between annotative and non annotative. The code below does a good job of setting the created dimension style to annotative. But when I ask chat gpt to make it in reverse, i.e. make a code that makes the created dimstyle non annotative, it can't. (defun set-dimstyle-annotative (dimstyle-name / ent entdata xdata) ;; Ensure the dimension style exists (if (and (setq ent (tblobjname "dimstyle" dimstyle-name)) (setq entdata (entget ent))) (progn ;; Check if XData for "AcadAnnotative" exists (if (not (assoc -3 entdata)) (progn ;; Add XData to set the dimension style as annotative (setq xdata '((-3 ("AcadAnnotative" (1000 . "AnnotativeData") (1002 . "{") (1070 . 1) ; Version number (1070 . 1) ; Annotative flag: 1 = Yes, 0 = No (1002 . "}") ) ) ) ) ;; Apply the XData to the dimension style (entmod (append entdata xdata)) (princ (strcat "\nDimension style '" dimstyle-name "' set to annotative.")) ) (princ (strcat "\nDimension style '" dimstyle-name "' is already annotative.")) ) ) (princ (strcat "\nDimension style '" dimstyle-name "' not found.")) ) (princ) ) Basically when a dimstyle is created, I put this at the end of the code to make it annotative. However, after making an annotative dimstyle, I can make a dimstyle, but because the previous was annotative, I cannot set the new dimstyle to non annotative. Chat gpt gave me a code but it seems it just butchered the code and it doesn't work. I attached the lisp file. Thanks!! DimStyles.lsp
- 2 replies
-
- annotative dimension
- autolisp
-
(and 1 more)
Tagged with:
-
I would like some help to create a function that would allow me to select a point in between two horizontal and/or vertical lines and it would give me the vertical and horizontal dimensions between those lines. It's a 2D drawing but some lines are of different z value. I have tried using chatgpt to create a code but it is not able to properly select the nearest line from my specified point (after running the command). This function is there in the new sketchup. I was hoping to use it to create internal dimensions in an architectural plan.
-
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. -
"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 my friends , Happy day.... I'm trying to solve an issue to help my non-coder friends. I'm using a Lisp file that contains all my routines, but I can't explain everything every time. So, I want to create a table inside AutoCAD that lists the shortcut commands and their descriptions, similar to how the TEXT COUNTER command works by Lee Mac. Any other suggestions could help me a lot. Thanks in advance my friends.... Attached is my lisp file Lisp Routine.lsp
-
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) ) -
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