All Activity
- Past hour
-
andrew13321 joined the community
- Today
-
k4teamine joined the community
-
sumants joined the community
-
Sh Ahmed joined the community
-
Saxlle started following Copying a Value into the Clipboard without using Active-X so it can work on LT
-
Copying a Value into the Clipboard without using Active-X so it can work on LT
Saxlle replied to CivilTechSource's topic in AutoLISP, Visual LISP & DCL
Why not just use princ to write the text in command line, then select it, ctrl+c and ctrl+v? For e.g. (setq a "213" b "abs" c "ddd") (princ (strcat a " " b " " c)) (princ) ------------------------------- result: 213 abs ddd (select then in command line and paste it) -
Copying a Value into the Clipboard without using Active-X so it can work on LT
Tharwat replied to CivilTechSource's topic in AutoLISP, Visual LISP & DCL
I think saving the string to a temporary text file and importing it when needed for insertion should accomplish the task. -
Copying a Value into the Clipboard without using Active-X so it can work on LT
CivilTechSource replied to CivilTechSource's topic in AutoLISP, Visual LISP & DCL
Hi @BIGAL! I did not explore the option of going straight away to the PDFing. The reason is most likely that sometimes we need to tweak the settings (turn transparency on, or object lineweight). So my idea was to have the lisp extract the Drawing name components (Dwg.Number-Status-Revision-Dwg.Name) and save it in the clipboard so the user can paste it in the dialogbox when saving the drawing. The shell solution seemed pretty good and it does work on the full cad but did not work on LT. @Lee Mac maybe you have some thoughts on this? @BIGAL thanks you so much for being so helpful! -
elleemdee02 joined the community
-
Really nice Marko! Handy cleaning tool, really does help. Thanks again
-
Pathfinding in AutoCAD with the A-Star Algorithm (A*)
ymg3 replied to heschr's topic in AutoLISP, Visual LISP & DCL
In your addition the F3dpol subroutine will be quite slow for path with long vertex due to the (apply append) actually 4 times slower than mk_3dp. If you insist on going visual lisp the following would be faster by a factor of 2. ;Added by GLAVCVS Modified by ymg (defun f3Dpol (plst / sa i p element sa obj ) (setq sa (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* (length plst) 3))))) (setq i 0) (foreach p plst (foreach element p (vlax-safearray-put-element sa i (float element)) (setq i (1+ i)) ) ) (setq obj (vla-Add3DPoly #acspc sa)) (vla-put-Color obj #Pathcol) (vla-put-lineweight obj #Pathlwt) ) Here is mk_3dp: ;; ; ;; mk_3dp by Alan J Thompson ; ;; ; ;; Argument: lst, A list of points (2d or 3d) ; ;; ; ;; Create an 3dPolyline ; ;; Return: Polyline ename ; ;; ; (defun mk_3dp (lst / vtx) (if (and (> (length lst) 1)) (progn (entmakex (list '(0 . "POLYLINE") '(10 0. 0. 0.) (cons 8 #Pathlay) (cons 62 #Pathcol) (cons 370 #Pathlwt) '(70 . 8) ) ) (foreach vtx lst (entmakex (list '(0 . "VERTEX") (cons 10 vtx) '(70 . 32) ) ) ) (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND")))))) ) ) ) And find below Benchmark result _$ (benchmark '((mk_3dp lst) (f3dpol lst))) Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s): (MK_3DP LST).....1672 / 1.92 <fastest> (F3DPOL LST).....3218 / 1 <slowest> _$ -
AntonHe31416 joined the community
- Yesterday
-
Copying a Value into the Clipboard without using Active-X so it can work on LT
BIGAL replied to CivilTechSource's topic in AutoLISP, Visual LISP & DCL
I think code can be made easier, yes LT does support VL just not a full set but should support "getattributes" an easier way of getting attribute values or you may be able to use the getpropertyvalue method even easier. Have a look at Lee-mac ssget functions. you should use "E" to select block. https://www.lee-mac.com/ssget.html If the desired result is to plot ";; 6. Launch Plot Command" say a PDF with a known filename please say so, no need for a clipboard. There are plenty of plot lisps out there. You need to provide more details, is the title block true size or scaled, what device for output, PDF, A3, A1, plotter names and so on. Is it in model or a layout ? A couple of test code just try them. Property would be easiest, please let me know if it works in LT. (DEFUN C:test ( / ) (setq ent (car (entsel "\npick block "))) (setq dwgno (strcase (getpropertyvalue ent "DRAWING_NO.") T))) (princ) ) ; Wrapper the entsel in a while is it a BLOCK with attributes so if wrong pick do again. A enter check would be exit. ; in this test looks for one attribute but can redo as look for multiple atts and save value in varaibles. (defun c:test ( / ) (setq obj (vlax-ename->vla-object (car (entsel "\nPick block with attributes ")))) (setq atts (vlax-invoke obj 'Getattributes)) (vlax-for att atts (if (= (vlax-get att 'textstring) "DRAWING_NO.") (setq dwgno (strcase (getpropertyvalue ent "DRAWING_NO.") T))) ) ) (princ) ) -
"OEM environment." If you are using a OEM version then a possible way to run other lisp programs is to go back to the developer who could add your lisps to their package then they should work.
-
Geometric Constraints in AutoCAD: Tuesday Tips With Frank
The AutoCAD Blog posted a topic in AutoCAD Blogs
Remember when you were first learning to use AutoCAD? You learned about the Line command, and probably created a rectangle shape out of four line segments. Not long after, you learned about the Rectangle command and subsequently the Polyline command. You found that your rectangle is actually a closed polyline. How handy! But it doesn’t behave like a rectangle. Grip edit a corner and end up with a weird trapezoid shape. Maybe you’ve created a slot-shaped object using the Fillet command trick that I showed you in this post. Again, you don’t want it to lose its slot shape when you edit it. But, as the animation below demonstrates, that’s exactly what happens. What’s a drafter to do? In this case, the answer lies in Constraints. Click on the Parametric tab of the Ribbon to get started. Yes, it’s a pretty busy menu with lots of icons. If you’re like a lot of 2D drafters, you’re probably aware of it, but have also probably never used constraints for anything. Don’t worry, this isn’t going to be a full tutorial on how to use them. AutoCAD gives you a shortcut and does the work for you. On the left side of the Geometric tab, you’ll see a large Auto Constrain icon. Using it is extremely easy. You’ll be prompted to select objects… so select the objects you want to constrain. In our example, we’ll do the slot first and the rectangle second. But first, there are a few things you’ll want to know if this is your first experience using geometric constraints in AutoCAD. Working with Geometric Constraints in AutoCAD Next to the Auto Constrain icon, you’ll see all of the types of constraints you can apply. These are things like perpendicular, concentric, or parallel. When a constraint is applied to an object, an icon of the constraint type will display at the affected geometric point. You’ll want to know that you can show or hide them using the tools to the right of the geometric constraint icons. There’s also a very handy Delete Constraints tool in the Manage tab at the far right. You’ll be prompted to select objects. Choose what you want, or if you want to affect the entire drawing, just type in All. Why did I want to make sure you’re aware of this? Imagine getting in a drawing from an external source, and nearly all of your attempts at editing it give you weird results. What could the problem be? Well, perhaps constraints have been applied, but all of their icons have been hidden. Just click on Show All, then Delete Constraints, and select all if you don’t want them. Badda bing – problem solved. ** OK, so we’re going to be using the Auto Constrain feature on the slot. It will apply whatever constraints that it finds to your selected object(s). In this case, it uses Tangent, Parallel, and Horizontal. Now, as we see in the animation below, grip editing the shape will now retain its shape. That was easy. Two clicks and you’re done. But there may be some situations where Auto Constrain will constrain your object too much. You can also easily manage the constraints that it will use. For our Rectangle, we want to do just that, as if you use the default set, it will be constrained so much that you can’t grip edit it all. Your only option while in the Auto Constrain command is to access the settings box. You can do this from the pull-down menu if you have Dynamic Input turned on, or by just typing S into the Command Line. The Constraints Settings dialog can also be accessed by clicking on the little arrow icon at the corner of the Geometric panel before using Auto Constrain. If you do it this way, you’ll need to make sure to click on the AutoConstrain tab. By default, all constraint types but Equal are checked to be used. For our rectangle, we want to apply only the Perpendicular constraint. Again, this is very easy. Just click on the Clear All button, then click on the check for Perpendicular. Close the dialog with OK, and you’re ready to go. Select the rectangle and then enter. The perpendicular constraint icons will appear, and now when you grip-edit the corner, it retains its shape. That’s All Folks Geometric constraints can be extremely powerful, or incredibly annoying (especially if you don’t know they’re there). In today’s example, I’ve shown you an easy way to use them to maintain geometric shapes. As for my story about the incoming constrained drawing? I know this because it happened to me, and more than once. Well, actually, it would happen to my users. As the CAD Manager, I’d get the call or the message, and off I’d go to debug the problem. And a final word of warning. Do not ever, under any circumstances, use Auto Constrain on all the objects in your neighbor’s open drawing and hide their icons while your co-worker is in the break room on April Fool’s Day. It is in no way funny. We here at Tuesday Tips HQ do not condone this behavior and disavow any responsibility. More Tuesday Tips Check out our whole Tuesday Tips series for ideas on how to make AutoCAD work for you. The post Geometric Constraints in AutoCAD: Tuesday Tips With Frank appeared first on AutoCAD Blog. View the full article -
Tanzim Nasir joined the community
-
Pathfinding in AutoCAD with the A-Star Algorithm (A*)
GLAVCVS replied to heschr's topic in AutoLISP, Visual LISP & DCL
I think I chose the wrong version from my test code in the previous release. There are some bugs that affect drawings containing splines. This version should fix those bugs. ;; Pathfinding with the A* algorithm by ymg 22/07/2024 ; ;; ; ;; Revised a prog by HELMUT SCHRÖDER - heschr@gmx.de - 2014-09-14 ; ;; found at Cadtutor.net ; ;; ; ;; Kept the same format for edges list but added lines as valid choice ; ;; Format: (((x1 y1) (x2 y2)) (((x2 y2) (x3 y3))....(xn yn))) ; ;; ; ;; The user is asked to pick a start and an endpoint. ; ;; The program will find the shortest path in a network of connected ; ;; polylines and/or lines and draw a new polyline representing the result. ; ;; ; ;; Two lists of nodes openlst and closelst are created from the above ; ;; mentionned edges list. The format of a node list is: ; ;; (((Point) (Prev Point) Cumulated_Distance Estimated_Total_Distance)...) ; ;; ; ;; Main change from origina are: ; ;; - cons the list instead of append ; ;; - vl-sort the openlist instead of the quicksort ; ;; - Replaced and renamed some vars and subroutine. ; ;; - Added fuzz 1e-4 to all points comparison ; ;; - Change the get_path function ; ;; - Added line as possible edges ; ;; - Added an error handler ; ;; - Added a timer to the search portion of the program ; ;; ; ;; The above changes amounted to an acceleration of about 4x from the ; ;; original program. ; ;; : ;; If you compile this program to a .fas you'll get more than 10x faster. ; ;; ; ;| Added or revised code by GLAVCVS (january 2026) -All set are grouped into one -An associative sparse matrix cell->handles is created for faster cell querying (using new 'addToDict' and 'getCell' functions) -The "edges" list is replaced with the local search retourned by 'getCell' T E S T S ===== fas: 4-5 x faster than previous fas lsp: 7-8 x faster than previous lsp (february 8, 2026): -Added new function '·dist·' for measuring distances of curved segments -Added a new lightweight function 'glvFix' to prevent possible rounding mismatches -Added a new function 'EBiPts' to control obtaining coordinates from LINE and SPLINE objects -Several modifications to include in filters and matrix the necessary compatibility with curved linear objects |; (defun c:A** (/ *error* addToDict getCell upd_openlst in_openlst get_path memberfuzz mk_lwp f3Dpol LM:rtos set_errhandler sspl i startp endp e openlst closelst found acdoc lstClvs Pathlay Pathcol Pathlwt varl node ti ·dist· glvFix ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* (msg) (if e (if command-s (command-s "_.draworder" e "" "_f") (vl-cmdf "_.draworder" e "" "_f") ) ) (mapcar (function eval) varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (vla-endundomark acdoc) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS ;;;Create dictionary (defun addToDict (en / p val id clv i l c a to sp pl) (setq i -1 id (cdr (assoc 5 (setq l (entget en)))) c (= (setq to (cdr (assoc 0 l))) "LINE") sp (= to "SPLINE") pl (= to "POLYLINE")); a 10) (while (setq p (if (and (setq i (1+ i)) (or c sp pl)) (eBiPts en i) (vlax-curve-getPointAtParam en i))) (if (setq val (assoc (setq clv (strcat (itoa (glvFix (car p) 0.0001)) "," (itoa (glvFix (cadr p) 0.0001)) "," (itoa (glvFix (caddr p) 0.0001)))) lstClvs)) (setq lstClvs (subst (append val (list (cons id i))) val lstClvs)) (setq lstClvs (cons (list clv (cons id i)) lstClvs)) ) ) ) (defun ·dist· (r e p1 p2) (if r (vlax-curve-getEndParam e) (abs (- (vlax-curve-getDistAtParam e p1) (vlax-curve-getDistAtParam e p2))))) ;;;return list cell ;;*** Modified to access the new dictionary format *** (defun getCell (pt / val clv lr pr par l c oc p0 p to sp pl) (defun oc (c e i) (if c (cdr (assoc (+ i 10) l)) (vlax-curve-getPointAtParam e i))) (if (setq val (assoc (setq clv (strcat (itoa (glvFix (car pt) 0.0001)) "," (itoa (glvFix (cadr pt) 0.0001)) "," (itoa (glvFix (caddr pt) 0.0001)))) lstClvs)) (foreach par (cdr val) (setq e (handent (car par)) c (= (setq to (cdr (assoc 0 (setq l (entget e))))) "LINE") sp (= to "SPLINE") pl (= to "POLYLINE")) (if (zerop (setq pr (cdr par))) (setq lr (cons (list (cond (c "l") (sp "s") (pl "p")) e pr (1+ pr)) lr)) (setq lr (cons (list (cond (c "l") (sp "s") (pl "p")) e (1- pr) pr) lr) lr (if ((if (or c sp pl) eBiPts vlax-curve-getPointAtParam) e (1+ pr)) (cons (list (cond (c "l") (sp "s") (pl "p")) e pr (1+ pr)) lr) lr) ) ) ) ) ) (defun eBiPts (e pr / v0 v1 lp) (cond ((zerop pr) (vlax-curve-getStartPoint e)) ((= pr 1) (vlax-curve-getEndPoint e))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ; ;; upd_openlst ; ;; ; ;; Each node of the openlst is passed to this sub and we scan the edges list ; ;; to find the corresponding edges. Then both points of the edges are tested ; ;; for equality to the nodes. The fixed cost (distance) is updated and so is ; ;; the estimated total distance. Updates are first put in a temporary node. ; ;; ; ;; We then proceed to test if the temp variable is already in the closelst ; ;; and proceed to the next edge. ; ;; ; ;; If temp is true and temp is not in closelst we go to the recursive sub ; ;; in_openlst which adjust the values and return the updated openlst ; ;; ; ;; Upon return we sort the openlst on smallest estimated distance ; ;; and return the openlst to the main routine ; ;; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun upd_openlst (node endp openlst closelst / lEdges pt fcost p1 p2 d f e r temp) (setq pt (car node) fcost (caddr node) ) (setq lEdges (getCell pt)) (foreach edge lEdges (setq f (if (setq r (member (car edge) '("l" "s" "p"))) eBiPts vlax-curve-getPointAtParam);new e (cadr edge);new pr1 (caddr edge);new pr2 (cadddr edge);new p1 (f e pr1);new p2 (f e pr2);new d (·dist· r e pr1 pr2);new temp nil ) (cond ((equal pt p1 1e-4) (setq temp (list p2 p1 (+ fcost d) (+ fcost d (distance p2 endp)))) ) ((equal pt p2 1e-4) (setq temp (list p1 p2 (+ fcost d) (+ fcost d (distance p1 endp)))) ) ) (if (and temp (not (memberfuzz (car temp) closelst))) (setq openlst (in_openlst temp openlst)) ) ) (vl-sort openlst (function (lambda (a b) (< (cadddr a) (cadddr b))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun in_openlst (node lst) (cond ((not lst) (list node)) ((equal (car node) (caar lst) 1e-4) (if (< (cadddr node) (cadddr (car lst))) (cons node (cdr lst)) lst ) ) (t (cons (car lst) (in_openlst node (cdr lst)))) ) ) ;; ; ;; get_path ; ;; ; ;; Returns The list of points of shortest path found from closelst. ; ;; ; (defun get_path (lst / path) (setq path (list (caar lst)) prev (cadar lst) lst (cdr lst) ) (while (setq lst (memberfuzz prev lst)) (setq prev (cadar lst) path (cons (caar lst) path) ) ) path ) ;; ; ;; memberfuzz by Gile Chanteau ; ;; ; ;; Modified to work with nodes list ; ;; ; (defun memberfuzz (p lst) (while (and lst (not (equal p (caar lst) 1e-4))) (setq lst (cdr lst)) ) lst ) ;; ; ;; f3Dpol ; ;; ; ;; Draw an 3dpolyline given a point list ; ;; ; ;; Will be drawn on layer, lineweight and color defined by Variables ; ;; at beginning of program. ; ;; ; ;;;ADDED by GLAVCVS (defun f3Dpol (pts c / ep ll la e) (setq ep (if (= 1 (getvar (quote cvport))) (vla-get-PaperSpace acdoc) (vla-get-ModelSpace acdoc)) ll (apply (function append) pts) la (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length ll)))) (mapcar (function float) ll)) e (vla-Add3DPoly ep la) ) (vla-put-Color e c) (vla-put-Layer e Pathlay) (vla-put-Lineweight e Pathlwt) (vlax-vla-object->ename e) ) ;; ; ;; mk_lwp ; ;; ; ;; Draw an lwpolyline given a point list ; ;; ; ;; Will be drawn on layer with color and lineweight defined by Variables ; ;; at beginnung of program. ; ;; ; (defun mk_lwp (pl) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 Pathlay) (cons 62 Pathcol) (cons 90 (length pl)) (cons 70 (* 128 (getvar (quote plinegen)))) (cons 370 Pathlwt) ) (mapcar (function (lambda (a) (cons 10 a))) pl) ) ) ) (defun glvFix (r i / f f1) (if (= (setq f (fix r)) (setq f1 (fix (+ r i)))) f f1)) ;; A wrapper for the rtos function to negate the effect of DIMZIN - Lee Mac (defun LM:rtos (real units prec / dimzin result) (setq dimzin (getvar (quote dimzin))) (setvar (quote dimzin) 0) (setq result (vl-catch-all-apply (function rtos) (list real units prec))) (setvar (quote dimzin) dimzin) (if (not (vl-catch-all-error-p result)) result ) ) ;; Error Handler by Elpanov Evgenyi ; (defun set_errhandler (l) (setq varl (mapcar (function (lambda (a) (list (quote setvar) a (getvar a)))) l)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Change values of following 3 variables to suit your need. ; (setq Pathlay "0" Pathcol 3 ; 1=Red 2=Yellow 3=Green etc. ; Pathlwt 30 ; lineweight for path 0.3 mm ; ) (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))) (set_errhandler (list "clayer" "osmode" "cmdecho")) (setvar (quote cmdecho) 0) (setvar (quote osmode) 1) (setvar (quote lwdisplay) 1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (prompt "\nSelect LINE and polygonal POLYLINE network entities...") (if (setq sspl (ssget '((0 . "*LINE")))) (foreach en (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sspl))) (addToDict en) ) ) (initget 1) (setq startp (getpoint "\nPick or specify Start Point : ")) (initget 1) (setq endp (getpoint "\nPick or specify End Point : ")) (setq openlst (list (list startp (list 0.0 0.0 0.0) 0.0 (distance startp endp)))) (vla-startundomark acdoc) (setq ti (getvar (quote millisecs))) (while (and openlst (not found)) (setq node (car openlst)) (if (equal (car node) endp 1e-4) (setq found t closelst (cons node closelst)) (setq closelst (cons node closelst) openlst (upd_openlst node endp (cdr openlst) closelst)) ) ) (if found (if (vl-some (function (lambda (x) (not (equal (last x) 0.0 1e-4)))) (setq path (get_path closelst))) (setq e (f3Dpol path Pathcol)) (setq e (mk_lwp path)) ) (alert "No path was found...") ) (princ (strcat "\nExecution time : " (itoa (- (getvar (quote millisecs)) ti)) " milliseconds...")) (*error* nil) ) PS: As I mentioned earlier, the object representing the route remains the same polyline as in the previous code examples. Therefore, although the calculations did take curved segments into account, the final polyline marking the route will still draw straight segments. -
I found some lacks, so I had to change my latest attachments... M.R.
-
Copying a Value into the Clipboard without using Active-X so it can work on LT
CivilTechSource posted a topic in AutoLISP, Visual LISP & DCL
Hi again! I had this crazy idea to automate the drawing name process by making a lisp that will generate the drawing name (using titleblock attributes Name, Dwg.no, revision, status and so on). I have the below lisp that works great on AutoCAD, but I need it to work on LT. My question: Is there a way where AutoCad LT to copy something into the clipboard? (defun C:PrintMe (/ ss en ent data dwgno dwgstatus dwgrevision dwgtitle Dwg_No Dwg_Status Dwg_Rev Dwg_Name final fPath fPtr curTag curVal titleblockname _TitleCase) ;; Helper Function: Convert string to Title Case (e.g. "GROUND FLOOR" -> "Ground Floor") (defun _TitleCase (str / res cap next) (setq str (strcase str t) ; lowercase whole string res "" cap t) ; flag for first letter (repeat (strlen str) (setq next (substr str 1 1) str (substr str 2)) (if (= next " ") (setq res (strcat res next) cap t) (if cap (setq res (strcat res (strcase next)) cap nil) (setq res (strcat res next)) ) ) ) res ) ;; 1. Configuration (setq titleblockname "LE Titleblock Information `@A1") (setq dwgno "DRAWING_NO.") (setq dwgstatus "VIS_TEXT") (setq dwgrevision "REV") (setq dwgtitle "DRAWING_TITLE") ;; 2. Selection Logic (setq ss (ssget "_I" (list '(0 . "INSERT") (cons 2 titleblockname)))) (if ss (setq en (ssname ss 0)) (setq en (car (entsel "\nSelect the Title Block: "))) ) (if en (progn (princ "\nProcessing Plot Name...") (command "_.UPDATEFIELD" en "") (setq ent (entnext en)) ;; 3. Loop through attributes (while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND")) (setq data (entget ent)) (setq curTag (strcase (cdr (assoc 2 data)))) (setq curVal (cdr (assoc 1 data))) (cond ((= curTag (strcase dwgno)) (setq Dwg_No curVal)) ((= curTag (strcase dwgstatus)) (setq Dwg_Status curVal)) ((= curTag (strcase dwgrevision)) (setq Dwg_Rev curVal)) ((= curTag (strcase dwgtitle)) (setq Dwg_Name curVal)) ) (setq ent (entnext ent)) ) ;; 4. Construct Final String (if (and Dwg_No (/= Dwg_No "")) (progn ;; Extract first 2 chars of Visibility (if (and Dwg_Status (/= Dwg_Status "")) (setq Dwg_Status (substr Dwg_Status 1 2)) (setq Dwg_Status "XX") ) ;; Handle Revision default (if (or (not Dwg_Rev) (= Dwg_Rev "")) (setq Dwg_Rev "00")) ;; Apply Title Case to Dwg_Name (if (or (not Dwg_Name) (= Dwg_Name "")) (setq Dwg_Name "Untitled") (setq Dwg_Name (_TitleCase Dwg_Name)) ) ;; Combine string (using your "_" separator for the title) (setq final (strcat Dwg_No "-" Dwg_Status "-" Dwg_Rev "_" Dwg_Name)) ;; 5. Send to Clipboard (setq fPath (strcat (getvar "TEMPPREFIX") "clip_tmp.txt")) (setq fPtr (open fPath "w")) (princ final fPtr) (close fPtr) (command "_.SHELL" (strcat "clip < \"" fPath "\"")) (princ (strcat "\nSuccess! '" final "' copied to clipboard.")) (princ "\n") ;; 6. Launch Plot Command (initdia) (command "_.PLOT") ) (princ "\nError: Drawing Number (DRAWING_NO.) is empty.") ) ) (princ "\nError: No valid Title Block selected.") ) (princ) ) ;; Activation command: PRINTME -
The more recent poster is having an issue running the LISP. Which is here... (defun RlxPreviewDcl_MainDialogActions () (action_tile "bt_dcl_source_folder" "(RlxPreviewDcl_SelectDclSourceFolder)") (action_tile "eb_dcl_source_folder" "(RlxPreviewDcl_CheckManualInputSourceFolder $value)") ;<============== (action_tile "lb_dcl_filenames" "(RlxPreviewDcl_SelectDclSourceFile $value )") ;(action_tile "lb_dcl_dialognames" "(setq dialog-name (nth (atoi $value) dcl-dialognames))") (action_tile "lb_dcl_dialognames" "(RlxPreviewDcl_SelectDialogName (nth (atoi $value) dcl-dialognames))") (action_tile "accept" "(done_dialog 1)")) I ran one I had already (it seems slightly different) and also ran the one above by @rlx, it ran fine for me on several DCLs.
-
Akash_SAK joined the community
-
2 Step Command Alias in PGP File
Akash_SAK replied to EVGA Buzzer's topic in AutoCAD Beginners' Area
what if ? In our setup, we have access only to the .pgp (Program Parameters) file and do not have permission to load or execute AutoLISP (.lsp) files. As you may be aware, .pgp files are limited to defining command aliases only and cannot execute command logic, options or automation. For reference, below is the AutoLISP command we are currently using in standard AutoCAD: (Defun C:QD () (Command "LENGTHEN" "DELTA" pause) ) This LISP command: Launches the LENGTHEN command Automatically selects the DELTA option Pauses for user input However, when restricted to .pgp files, the closest possible format is only an alias, such as: D, *DIMLINEAR (example only) Unfortunately, .pgp files cannot replicate AutoLISP behavior, meaning they cannot pass command options (e.g., DELTA) and cannot include pauses or logic and can only map a shortcut to an existing command. As a result, the above LISP logic cannot be converted or replicated using .pgp alone. The only feasible workaround in a .pgp-only environment is to map a shortcut directly to the base command (e.g., LENGTHEN), after which options must be entered manually by the user. I wanted to highlight this limitation so expectations can be aligned accordingly. Please let me know if macro-based solutions (CUI macros) or additional permissions can be considered within the OEM environment. Thanks in advance for the understanding and support. - Last week
-
Not sure what your after, you can preview/display the dcl but it has no interaction. A lisp looks at what happens with "Action" of the Keys. Can you explain more what it is your trying to achieve.
-
I've finished with "lw_orth.lsp"... Take it, or leave it... It's up to you OP... I've found some lacks in latest updates - in 3d with ucs aligned in 3d with lwpolylines (grread-mult) versions produced unwanted behaviour... Hopefully now fixed... Also, added (vl-cmdf "_.undo" "_m") as first line at each command function, so upon finished execution, you can just use UNDO (Back) to return before running command... There was 5 downloads till I reattached fixed version... Sorry for inconvenience - it happens from time to time... Regards, M.R. orthogonalize_lwpolyline-ucs3D.dwg lw_orth.lsp
-
tonio501 joined the community
-
Are you using AutoCAD LT? You posted in the AutoCAD LT Forum, but your profile shows AutoCAD 2026 (which is full AutoCAD).
-
Are you sure you copied it correctly? Runs just fine on my AutoCAD 2026.
-
Pathfinding in AutoCAD with the A-Star Algorithm (A*)
GLAVCVS replied to heschr's topic in AutoLISP, Visual LISP & DCL
PS I forgot one detail: the resulting route won't emulate the curves, if there are any. It will simply draw straight segments. -
Steven P started following Converting menues
-
A little tip - when you find setting like these that sets CAD to how you like it, put them into a LISP (setvar 'menubar 1) for example - mine is saved something like CADSettings.LSP... so that when it is upgrade time there is half a chance of a quick fix to make thing 'correct' - or spend a day trying to remember what you did 2, 5 or 10 years ago. Add comments so you know what each does,
-
Pathfinding in AutoCAD with the A-Star Algorithm (A*)
GLAVCVS replied to heschr's topic in AutoLISP, Visual LISP & DCL
I took a look at your modifications to make the code more robust I have to say that I didn’t think it would be possible to consider the presence of “splines” in the drawing. But I agree with including this filter in the current code. As for the filters for “legacy” POLYLINEs and LWPOLYLINEs, the code wouldn’t need those filters if we accept the premise that only straight distances between points will be measured. BUT: to also cover this possibility, I’ve introduced a new function and made some modifications that allow any “*LINE” to be included in the analysis (including any “POLYLINE” or “SPLINE”). In this way, the filters for the selection set become, once again, much simpler. This also allows the drawing to compute routes using curved linear objects (arcs are excluded for now). Regarding the use of LM:rtos, I consider this optional for cases where small cells are desired, and this may introduce some drawbacks. Moreover, using such small cells significantly harms execution speed. I ran a comparison between the execution speed of your code and this new one I’m attaching, and yours is 3 x slower. Additionally, creating the matrix with your requirements is also quite slow. ;; Pathfinding with the A* algorithm by ymg 22/07/2024 ; ;; ; ;; Revised a prog by HELMUT SCHRÖDER - heschr@gmx.de - 2014-09-14 ; ;; found at Cadtutor.net ; ;; ; ;; Kept the same format for edges list but added lines as valid choice ; ;; Format: (((x1 y1) (x2 y2)) (((x2 y2) (x3 y3))....(xn yn))) ; ;; ; ;; The user is asked to pick a start and an endpoint. ; ;; The program will find the shortest path in a network of connected ; ;; polylines and/or lines and draw a new polyline representing the result. ; ;; ; ;; Two lists of nodes openlst and closelst are created from the above ; ;; mentionned edges list. The format of a node list is: ; ;; (((Point) (Prev Point) Cumulated_Distance Estimated_Total_Distance)...) ; ;; ; ;; Main change from origina are: ; ;; - cons the list instead of append ; ;; - vl-sort the openlist instead of the quicksort ; ;; - Replaced and renamed some vars and subroutine. ; ;; - Added fuzz 1e-4 to all points comparison ; ;; - Change the get_path function ; ;; - Added line as possible edges ; ;; - Added an error handler ; ;; - Added a timer to the search portion of the program ; ;; ; ;; The above changes amounted to an acceleration of about 4x from the ; ;; original program. ; ;; : ;; If you compile this program to a .fas you'll get more than 10x faster. ; ;; ; ;| Added or revised code by GLAVCVS (january 2026) -All set are grouped into one -An associative sparse matrix cell->handles is created for faster cell querying (using new 'addToDict' and 'getCell' functions) -The "edges" list is replaced with the local search retourned by 'getCell' T E S T S ===== fas: 4-5 x faster than previous fas lsp: 7-8 x faster than previous lsp (february 8, 2026): -Added new function '·dist·' for measuring distances of curved segments -Added a new lightweight function 'glvFix' to prevent possible rounding mismatches -Several modifications to include in filters and matrix the necessary compatibility with curved linear objects |; (defun c:A** (/ *error* addToDict getCell upd_openlst in_openlst get_path memberfuzz mk_lwp f3Dpol LM:rtos set_errhandler sspl i startp endp e openlst closelst found acdoc lstClvs Pathlay Pathcol Pathlwt varl node ti ·dist· glvFix ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* (msg) (if e (if command-s (command-s "_.draworder" e "" "_f") (vl-cmdf "_.draworder" e "" "_f") ) ) (mapcar (function eval) varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (vla-endundomark acdoc) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;ADDED by GLAVCVS ;;;Create dictionary (defun addToDict (en / p val id clv i l c a) (setq i -1 id (cdr (assoc 5 (setq l (entget en)))) c (= (cdr (assoc 0 l)) "LINE") a 10) (while (setq p (if (and (setq i (1+ i)) c) (cdr (assoc (+ a i) l)) (vlax-curve-getPointAtParam en i))) (if (setq val (assoc (setq clv (strcat (itoa (glvFix (car p) 0.0001)) "," (itoa (glvFix (cadr p) 0.0001)) "," (itoa (glvFix (caddr p) 0.0001)))) lstClvs)) ;(setq val (assoc (setq clv (strcat (LM:rtos (car p) 2 4) "," (LM:rtos (cadr p) 2 4) "," (LM:rtos (caddr p) 2 4))) lstClvs)) (setq lstClvs (subst (append val (list (cons id i))) val lstClvs)) (setq lstClvs (cons (list clv (cons id i)) lstClvs)) ) ) ) (defun ·dist· (l? e p1 p2) (if l? (vlax-curve-getEndParam e) (abs (- (vlax-curve-getDistAtParam e p1) (vlax-curve-getDistAtParam e p2))))) ;;;return list cell ;;*** Modified to access the new dictionary format *** (defun getCell (pt / val clv lr pr par l c oc p0 p) (defun oc (c e i) (if c (cdr (assoc (+ i 10) l)) (vlax-curve-getPointAtParam e i))) (if (setq val (assoc (setq clv (strcat (itoa (glvFix (car pt) 0.0001)) "," (itoa (glvFix (cadr pt) 0.0001)) "," (itoa (glvFix (caddr pt) 0.0001)))) lstClvs)) (foreach par (cdr val) (setq e (handent (car par)) c (= (cdr (assoc 0 (setq l (entget e)))) "LINE")) (if (zerop (setq pr (cdr par))) (setq lr (cons (list c e pr (1+ pr)) lr)) (setq lr (cons (list c e (1- pr) pr) lr) lr (if (vlax-curve-getPointAtParam e (1+ pr)) (cons (list c e pr (1+ pr)) lr) lr) ) ) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ; ;; upd_openlst ; ;; ; ;; Each node of the openlst is passed to this sub and we scan the edges list ; ;; to find the corresponding edges. Then both points of the edges are tested ; ;; for equality to the nodes. The fixed cost (distance) is updated and so is ; ;; the estimated total distance. Updates are first put in a temporary node. ; ;; ; ;; We then proceed to test if the temp variable is already in the closelst ; ;; and proceed to the next edge. ; ;; ; ;; If temp is true and temp is not in closelst we go to the recursive sub ; ;; in_openlst which adjust the values and return the updated openlst ; ;; ; ;; Upon return we sort the openlst on smallest estimated distance ; ;; and return the openlst to the main routine ; ;; ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun upd_openlst (node endp openlst closelst / lEdges pt fcost p1 p2 d l? temp) (setq pt (car node) fcost (caddr node) ) (setq lEdges (getCell pt)) (foreach edge lEdges (setq l? (car edge);new e (cadr edge);new pr1 (caddr edge);new pr2 (cadddr edge);new p1 (vlax-curve-getPointAtParam e pr1);new p2 (if l? (vlax-curve-getEndPoint e) (vlax-curve-getPointAtParam e pr2));new d (·dist· l? e pr1 pr2);new temp nil ) (cond ((equal pt p1 1e-4) (setq temp (list p2 p1 (+ fcost d) (+ fcost d (distance p2 endp)))) ) ((equal pt p2 1e-4) (setq temp (list p1 p2 (+ fcost d) (+ fcost d (distance p1 endp)))) ) ) (if (and temp (not (memberfuzz (car temp) closelst))) (setq openlst (in_openlst temp openlst)) ) ) (vl-sort openlst (function (lambda (a b) (< (cadddr a) (cadddr b))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun in_openlst (node lst) (cond ((not lst) (list node)) ((equal (car node) (caar lst) 1e-4) (if (< (cadddr node) (cadddr (car lst))) (cons node (cdr lst)) lst ) ) (t (cons (car lst) (in_openlst node (cdr lst)))) ) ) ;; ; ;; get_path ; ;; ; ;; Returns The list of points of shortest path found from closelst. ; ;; ; (defun get_path (lst / path) (setq path (list (caar lst)) prev (cadar lst) lst (cdr lst) ) (while (setq lst (memberfuzz prev lst)) (setq prev (cadar lst) path (cons (caar lst) path) ) ) path ) ;; ; ;; memberfuzz by Gile Chanteau ; ;; ; ;; Modified to work with nodes list ; ;; ; (defun memberfuzz (p lst) (while (and lst (not (equal p (caar lst) 1e-4))) (setq lst (cdr lst)) ) lst ) ;; ; ;; f3Dpol ; ;; ; ;; Draw an 3dpolyline given a point list ; ;; ; ;; Will be drawn on layer, lineweight and color defined by Variables ; ;; at beginning of program. ; ;; ; ;;;ADDED by GLAVCVS (defun f3Dpol (pts c / ep ll la e) (setq ep (if (= 1 (getvar (quote cvport))) (vla-get-PaperSpace acdoc) (vla-get-ModelSpace acdoc)) ll (apply (function append) pts) la (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length ll)))) (mapcar (function float) ll)) e (vla-Add3DPoly ep la) ) (vla-put-Color e c) (vla-put-Layer e Pathlay) (vla-put-Lineweight e Pathlwt) (vlax-vla-object->ename e) ) ;; ; ;; mk_lwp ; ;; ; ;; Draw an lwpolyline given a point list ; ;; ; ;; Will be drawn on layer with color and lineweight defined by Variables ; ;; at beginnung of program. ; ;; ; (defun mk_lwp (pl) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 Pathlay) (cons 62 Pathcol) (cons 90 (length pl)) (cons 70 (* 128 (getvar (quote plinegen)))) (cons 370 Pathlwt) ) (mapcar (function (lambda (a) (cons 10 a))) pl) ) ) ) (defun glvFix (r i / f f1) (if (= (setq f (fix r)) (setq f1 (fix (+ r i)))) f f1)) ;; A wrapper for the rtos function to negate the effect of DIMZIN - Lee Mac (defun LM:rtos (real units prec / dimzin result) (setq dimzin (getvar (quote dimzin))) (setvar (quote dimzin) 0) (setq result (vl-catch-all-apply (function rtos) (list real units prec))) (setvar (quote dimzin) dimzin) (if (not (vl-catch-all-error-p result)) result ) ) ;; Error Handler by Elpanov Evgenyi ; (defun set_errhandler (l) (setq varl (mapcar (function (lambda (a) (list (quote setvar) a (getvar a)))) l)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Change values of following 3 variables to suit your need. ; (setq Pathlay "0" Pathcol 3 ; 1=Red 2=Yellow 3=Green etc. ; Pathlwt 30 ; lineweight for path 0.3 mm ; ) (or acdoc (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))) (set_errhandler (list "clayer" "osmode" "cmdecho")) (setvar (quote cmdecho) 0) (setvar (quote osmode) 1) (setvar (quote lwdisplay) 1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (prompt "\nSelect LINE and polygonal POLYLINE network entities...") (if (setq sspl (ssget '((0 . "*LINE")))) (foreach en (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex sspl))) (addToDict en) ) ) (initget 1) (setq startp (getpoint "\nPick or specify Start Point : ")) (initget 1) (setq endp (getpoint "\nPick or specify End Point : ")) (setq openlst (list (list startp (list 0.0 0.0 0.0) 0.0 (distance startp endp)))) (vla-startundomark acdoc) (setq ti (getvar (quote millisecs))) (while (and openlst (not found)) (setq node (car openlst)) (if (equal (car node) endp 1e-4) (setq found t closelst (cons node closelst)) (setq closelst (cons node closelst) openlst (upd_openlst node endp (cdr openlst) closelst)) ) ) (if found (if (vl-some (function (lambda (x) (not (equal (last x) 0.0 1e-4)))) (setq path (get_path closelst))) (setq e (f3Dpol path Pathcol)) (setq e (mk_lwp path)) ) (alert "No path was found...") ) (princ (strcat "\nExecution time : " (itoa (- (getvar (quote millisecs)) ti)) " milliseconds...")) (*error* nil) ) In any case, I haven’t tested the code thoroughly enough on drawings containing “splines” or other complex linear objects. In addition, there may be some situations that may not be covered. But it should work. In any case, the code is open to any improvements anyone may want to make. Best regards. -
no function definition: RLXPREVIEWDCL_CHECKMANUALINPUTSOURCEFOLDER
-
Another way around the task is to use a lisp to do all the calculations and the object from 1st principles. ie not a Dynamic block. Something like this. You could have a first dcl with images so choose shape, then 2nd dcl pops up with the enter values. Let me know if you want something, post a sample dwg for layers etc.
-
Good day all, I have a dynamic block that I use to stretch to the right size for fabrication of panels. I am trying to get the block to automatically add holes as the panel is stretched. The holes need to be spaced equally at maximum 16" o.c. I have set up all my formulas, etc. and in Block editor it looks good. The array is showing properly, etc. The problem is that when I stretch the panel, the holes and formulas do not automatically update. In fact when I stretch the panel, the Constraint dimension that I use for my calculations does not stretch with the panel. It moves the entire constraint dimension. Therefore my formulas are not updating and the array is not working as required. I have tried numerous attempts to get this dclinear dimensions to stretch with the panel to no avail. Maybe there is another way to do this? Ideally when i stretch the panel, the holes should update as per my formulas. Link to AutoCAD Forum with pictures. https://forums.autodesk.com/t5/announcements-and-meet-greet/dynamic-block-with-array-of-rivet-holes-problem/td-p/14007890 Any help is appreciated.
-
I've added (c:lw_orth-2) and (c:lw_orth-grread-2), but IMHO, version 1 is better... Here is link... Regards, M.R.
-
If I'm looking at the same subsystem, when you edit a part drawing, the Toolspace includes Model Parameters (under Modeling) and Size Parameters (under the part). When you right click on a part in the Size Parameters, you get an "Edit..." option. That opens an "Edit Part Sizes" window, which is a table. Pull down the box on the toolbar (the default is Values) and pick Parameter Configuration instead. That gives you a different table with more rows. One of those rows is Units. Check the units for your part and see if they match your drawing. If that doesn't take care of your issue, please give us more information.
