I've been using AutoLISP/CAD for a while and now I want to add a label with my name to all the open files. I've managed to iterate over all the open files, but the text command only runs in the first file. I thought it was too quick for CAD to work properly, so I added delays but it didn't work. I've checked in all the open files and the variables are shared and synced. By the way, the text is added once per open file, but only in the first one.
Here is my code:
(defun c:labeling()
(vl-load-com)
(setq docs (vla-get-documents (vlax-get-acad-object)))
(setq top (vla-get-count docs))
(setq p1 (list 10 -10))
(setq p2 (list 95 -15))
(setq p3 (list 12 -14))
(setq c 0)
(vl-propagate 'docs)
(vl-propagate 'top)
(vl-propagate 'p1)
(vl-propagate 'p2)
(vl-propagate 'p3)
(vl-propagate 'c)
(while (< c top)
(vla-activate (vla-item docs c))
(command "_rectang" p1 p2)
(command "delay" 500)
(command "_text" p3 "3" 0 "My name - year" "" nil)
;(print c)
(setq c (+ c 1))
(vl-propagate 'c)
(command "delay" 1000)
)
)
It's a bit complicated to explain in such short time I have but:
Each drawig has his own "namespace" probably it's wrong word, but nevermind.
When You run command it runs only in active drawing, but when You change active drawing You lost active lisp routine.
So it's not enought to activate drawing.
Better way is to draw by manipulate model object. for example like this:
(defun c:labeling()
(vl-load-com)
(setq docs (vla-get-documents (vlax-get-acad-object)))
(setq top (vla-get-count docs))
(setq p1 (list 10 -10))
(setq p2 (list 95 -15))
(setq p3 (list 12 -14))
(setq c 0)
(vlax-for ThisDoc docs
(setq Space (vlax-get-property ThisDoc 'ModelSpace ) )
(Rectangle Space p1 p2 )
(setq txt (vlax-invoke-method Space 'AddText "My name - year" (vlax-3d-point p3 ) 3 ))
(setq c (+ c 1))
)
)
(defun Rectangle ( Space P1 P2 / lpts pts poly )
(setq lpts (append p1 (list 0 ) (list (car p1 ) (cadr p2 ) 0 ) p2 (list 0 ) (list (car P2) (cadr p1) 0 ) ) )
(setq pts (L2v lpts vlax-vbDouble ) )
(setq poly(vlax-invoke-method Space 'AddPolyline pts ) )
(vlax-put-property poly 'Closed :vlax-true )
poly
)
(defun L2v(lista typ / NObj SelObjArray iCount iList SelObjArrayVar)
;|
vlax-vbInteger (2) Integer
vlax-vbLong (3) Long integer
vlax-vbSingle (4) Single-precision floating-point number
vlax-vbDouble (5) Double-precision floating-point number
vlax-vbString (8) String
vlax-vbBoolean (11) Boolean
vlax-vbVariant (12) Variant
|;
(setq NObj (length lista)
SelObjArray (vlax-make-safearray typ (cons 0 (1- NObj) ))
iCount 0)
(repeat NObj
(vlax-safearray-put-element SelObjArray iCount (nth iCount lista))
(setq iCount (1+ iCount))
)
(setq SelObjArrayVar (vlax-make-variant SelObjArray))
)
Related
I am new to coding but very eager to learn. I am attempting to edit this existing LISP to add additional materials to the list. Currently when I run the LISP it only has Aluminium as an option to select. I would like to add additional materials and weights to suit. I also would like to know how to change the weight settings from LBS/FT to Kilograms & Meters.
Any help would be hugely appreciated.
;;; Lisp function for calculating weight with choice to assign material for selected:
;;; 2d shape - expressed in pounds per foot lenght - lbs/ft.
;;; or
;;; 3d solid - expressed in Pounds - lbs
(defun C:Wt (/ area volume en ent obj ospace prefix pt remd resp suffix suffix1)
;;local defun
(defun density (mat)
(cond ((eq "Aluminium" mat) 0.0972) ;<--lb/in³
;; add other materials density similarly
(T nil)
)
)
(defun matname (mat)
(cond ((eq "Aluminium" mat) " mat: Aluminium")
;; add other materials names similarly
(T nil)
)
)
;;main part
(setvar "dynmode" 3)
(setvar "dynprompt" 1)
(setq ospace (vla-get-block
(vla-get-activelayout
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
)
(setq prefix "Weight="
suffix "lbs/ft."
suffix1 "lbs"
)
(setq ent (entsel "\nSelect a object:"))
(setq en (car ent))
(if (wcmatch (cdr (assoc 0 (entget en)))
"REGION,*POLYLINE,CIRCLE,ELLIPSE"
)
(progn
(setq obj (vlax-ename->vla-object en))
(initget
"Aluminium"
) ;<-- add other materials here
(setq resp
(getkword
"\Choose material [ALuminium] <AL>: "
)
)
(setq area (strcat prefix
(rtos (* (vla-get-area obj)
(density resp)
)
3 ;<-- inches
4 ;<-- precision
)
suffix
(matname resp)
)
)
(setq pt (getpoint "\nPick text point: "))
(vla-addtext
ospace
area
(vlax-3d-point (trans pt 1 0))
(getvar 'Textsize)
)
)
)
(princ)
(if (wcmatch (cdr (assoc 0 (entget en))) "3DSOLID")
(progn
(setq obj (vlax-ename->vla-object en))
(initget
"Aluminium Steel SS316 Glass Rubber Silicone Plastic Granit Marble"
) ;<-- add other materials here
(setq resp
(getkword
"\Choose material
[ALuminium/STeel/SS316/GLass/RUbber/SIlicone/PLastic/GRanit/MArble] <AL>: "
)
)
(setq volume (strcat prefix
(rtos (* (vla-get-volume obj)
(* (density resp) 0.001)
)
2 ;<-- metric
5 ;<-- precision
)
suffix1
(matname resp)
)
)
(setq pt (getpoint "\nPick text point: "))
(vla-addtext
ospace
volume
(vlax-3d-point (trans pt 1 0))
(getvar 'Textsize)
)
)
)
(princ)
)
I'm creating some AutoLisp commands for my team, and now that I'm finished, the code breaks apart in their computer and I can't figure out why. Works fine in mine.
The idea of the code is to stretch a polyline and update the block attributes that is grouped with.
The code asks to select the block, the actual width of the polyline and the fraction that is is supposed to take (ex: 0.75 to reduce to 75%).
Then, and here is were the problem starts, select the sides to stretch. On their computers, he does not allow to select, it simply jumps ahead.
(defun c:MRV (/ a b c d e)
;ungroup
(command "pickstyle" 0)
;variables
(setq blk (entsel "\nSelect block to modify: "))
(initget (+ 1 2 4))
(setq a (getreal "\nWidth?"))
(initget (+ 1 2 4))
(setq b (getreal "\nNew module fraction? (>0;1<)"))
;distance to reduce
(setq c (- 1 b))
(setq d (* a c -0.5))
(setq e (* -1 d))
;stretch
(command "stretch" pause pause "" "0,0" (polar '(0 0) (/ pi 2) d))
(command "stretch" pause pause "" "0,0" (polar '(0 0) (/ pi 2) e))
;open layer
(setq LayerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(if (and (tblsearch "LAYER" "MC_BLOCO_INFO_AREAS")
(setq layname (vla-item layertable "MC_BLOCO_INFO_AREAS"))
(= (vlax-get-property layname 'lock) :vlax-true)
)
(vla-put-lock layname :vlax-false))
;change attribute
(setq l (cons "CAMPO_6" (rtos b 2 2)))
(LM:SetAttributeValues (car blk) (list l))
;close layer
(setq LayerTable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(if (and (tblsearch "LAYER" "MC_BLOCO_INFO_AREAS")
(setq layname (vla-item layertable "MC_BLOCO_INFO_AREAS"))
(= (vlax-get-property layname 'lock) :vlax-false)
)
(vla-put-lock layname :vlax-true))
;update block width
(command "regenall")
;regroup
(command "pickstyle" 1)
(print "Modulo modificado.")
(princ)
)
(defun LM:SetAttributeValues ( blk lst / enx itm )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
(if (setq itm (assoc (strcase (cdr (assoc 2 enx))) lst))
(progn
(if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
(entupd blk)
)
(LM:SetAttributeValues blk lst)
)
(LM:SetAttributeValues blk lst)
)
)
)
What should be happening:
When the AutoCAD STRETCH command issues the prompt for a selection of objects selected using a crossing window (crossing the segments that are to be stretched), the prompt is a standard selection prompt and the STRETCH command will subsequently obtain information about how the selection was acquired in the same way as you might using the AutoLISP ssnamex function.
As such, I would suggest supplying the STRETCH command with a selection set which has already been acquired using a crossing window selection method.
For example, you might define a function such as:
(defun mystretch ( dis / pt1 pt2 sel )
(while
(and
(setq pt1 (getpoint "\nSpecify first point of crossing window: "))
(setq pt2 (getcorner pt1 "\nSpecify opposite point of crossing window: "))
(not (setq sel (ssget "_C" pt1 pt2)))
)
(princ "\nNo objects were found within the crossing window.")
)
(if sel
(progn
(command "_.stretch" sel "" "_non" '(0 0) "_non" (list 0 dis))
t
)
)
)
You can then evaluate the above function with the distance that you wish to stretch the objects in the Y-direction, e.g.:
(mystretch 10.0)
Or, using the variables in your code:
(mystretch d)
(mystretch e)
The function will then return t (True) if the user has supplied two valid points and the STRETCH command has been issued - you can test for this in your program before proceeding.
Using this approach you can ensure that the user has supplied two points defining a crossing window which intersects one or more objects prior to issuing the AutoCAD STRETCH command.
The use of the ssget crossing mode string (C) also ensures that you are always supplying the STRETCH command which has been obtained using a crossing selection method.
You may also wish to refer to this answer regarding the use of the _non object snap modifier and also the _. command prefix in the above example code.
does anyone have an AutoLisp routine to quickly draw a line connecting two parallel lines. I would really like something that works similar to the fillet command, except drawing a straight line instead of a radius. This could almost be accomplished with the chamfer command, except chamfer does not work with parallel lines.
My job sometimes consists of offsetting a lot of pairs of parallel lines and then connecting them with another line to create rectangles. It is easy enough to just draw a line between them, but it is still a tedious process.
(defun c:connectLines (/ line1 line2 data1 data2 pt1 pt2 pt3 pt4)
(and
(setq line1 (car (entsel "\nSelect first line: ")))
(= (cdr (assoc 0 (setq data1 (entget line1)))) "LINE")
(setq line2 (car (entsel "\nSelect second line: ")))
(= (cdr (assoc 0 (setq data2 (entget line2)))) "LINE")
(setq pt1 (cdr (assoc 10 data1))
pt2 (cdr (assoc 11 data1))
pt3 (cdr (assoc 11 data2))
pt4 (cdr (assoc 10 data2))
)
(or (< (distance pt2 pt3) (distance pt2 pt4))
(mapcar 'set '(pt3 pt4) (list pt4 pt3))
)
(command "_.erase"
(ssadd line2 (ssadd line1))
""
"_.pline"
"_non"
(trans pt1 0 1)
"_non"
(trans pt2 0 1)
"_non"
(trans pt3 0 1)
"_non"
(trans pt4 0 1)
"_close"
)
)
(princ)
)
I have a working lisp which creates spline from 3d polylines. My problem is I cant make it work to select multiple 3d polylines or entire layer, and also a lisp changes the result layer to the default layer. It should kept on the original one.
Here is my working lisp:
(defun c:3p2spl ( / *error* line2spl loop pl e s ss sss )
(vl-load-com)
(defun *error* ( msg )
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
(defun line2spl ( e / sp ep d )
(setq sp (cdr (assoc 10 (entget e)))
ep (cdr (assoc 11 (entget e)))
d (distance sp ep)
)
(entdel e)
(entmakex
(list
'(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
'(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)
)
)
)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq loop T)
(setq sss (ssget "_I"))
(if (and sss (eq (cdr (assoc 0 (entget (setq pl (ssname sss 0))))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 14)) (setq loop nil))
(while loop
(setq pl (car (entsel "\nPick 3DPOLYLINE to convert it to SPLINE")))
(if (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< 7 (cdr (assoc 70 (entget pl))) 14)) (setq loop nil))
)
(setq e (entlast))
(command "_.explode" pl "")
(setq ss (ssadd))
(while (setq e (entnext e))
(if (eq (cdr (assoc 0 (entget e))) "LINE")
(progn
(setq s (line2spl e))
(ssadd s ss)
)
)
)
(command "_.join" (ssname ss 0) ss "")
(*error* nil)
(princ)
)
if I change the ssget "_I" to ssget "_:E" I can select multiple lines however it will change to spline only the first one.
I didn't test this code, only read, so maybe I'm wrong, but I thing the problem is because:
...
(setq pl (ssname sss 0))
...
(command "_.explode" pl "")
You explode only first entity.
I think
(command "_.explode" pl "")
should be used inside loop by all sss items.
I'm new to LISP in autocad. The code shown below draws circles (with radius of 1) in a sloped line. What I don't understand is the value of "a" does not increase in increments of 1. The center of the circle drawn in autocad is (1,1) , (1.7071,1.7071) , (3,3) , (3.7071,3.7071) , (5,5) ... Can someone pls. explain why?
(defun c:wwq ()
(setq a 0)
(while (< a 10)
(setq a (+ 1 a))
(setq pt1 (list a a ) )
(command "circle" pt1 1 )
)
)
While using the AutoLISP command function, you have to care about active object snaps.
One way is to force object snaps to "none" within the (command ...) expression:
(defun c:wwq (/ a pt1)
(setq a 0)
(while (< a 10)
(setq a (+ 1 a))
(setq pt1 (list a a))
(command "_circle" "_none" pt1 1)
)
(princ)
)
Or, you can deactivate every osnap by setting the OSMODE system variable to 0 at the begining of the code and retore the previous value at the end (to be really safe, this method should need and error handler to insure the the previous value is reset in case an error occur during the code execution).
(defun c:wwq (/ a pt1 os)
(setq a 0
os (getvar 'osmode)
)
(setvar 'osmode 0)
(while (< a 10)
(setq a (+ 1 a))
(setq pt1 (list a a))
(command "_circle" pt1 1)
)
(setvar 'osmode os)
(princ)
)
Another way is to use the entmake function which is faster and do not care about osnaps.
(defun c:wwq (/ a)
(setq a 0.0)
(while (< a 10.0)
(setq a (+ 1.0 a))
(entmake
(list
(cons 0 "CIRCLE")
(list 10 a a 0.0)
(cons 40 1.0)
)
)
)
(princ)
)