Leaderboard

I implemented astar using a heap instead of the dictionnary proposed by @GLAVCVS. Safearray is used to simulate the heap. Was done with prompt in Google AI. Results the heap is faster specially if the graph is bigger. ;; ; ;; c:A* by ymg ; ;; Astar implemented with a Heap instead of a dictionnary ; ;; Edges of the Graph are drawn on layer identified by Golbal #Edgeslay ; ;; ; ;; Edges can be lines, lpolylines or 3dpolylines ; ;; You select Start and End points. Shortest is then found and drawn as a ; ;; 3D Polylines on layer, color and lineweight chosen via Global vars ; ;; found at beginning of this routine ; ;; ; ;; Heap has a faster running time than the dictionnary and list approach ; ;; as the size of the graph grows. ; ;; ; (defun c:A* (/ ss graph openH gScore cameFrom found cur curPt curK sNode sKey neighbor nKey t_g val oldG oldCF Startp Endp d minD en param endpar p1 p2 path k link pt i ti) (vl-load-com) (or #acdoc (setq #acdoc (vla-get-activedocument (vlax-get-acad-object)))) (set_errhandler '("CLAYER" "OSMODE" "CMDECHO" "DIMZIN")) (setvar 'CMDECHO 0) (setvar 'OSMODE 1) (setq #Edgelay "Edges" #Pathlay "Path" #Pathcol 1 #Pathlwt 70 #Hptr 0 ) ;; Selecting set of entities defining edges of graph. (if (not (setq ss (ssget "X" (list '(0 . "LINE,LWPOLYLINE,POLYLINE") (cons 8 #Edgelay))))) (progn (alert (strcat "\nError: No entities found on layer " #Edgelay)) (exit) ) ) (vla-startundomark #acdoc) ;; Geting Start and End points. (Use snap to endpoint) (setq Startp (getpoint "\nPick Start Point: ")) (mk_circle Startp 7.5 #Pathcol) (setq Endp (getpoint "\nPick End Point: ")) (mk_circle Endp 7.5 3) (setq ti (getvar 'MILLISECS)) ;Timer for execution time ; Building Graph... (setq graph nil i 0) (repeat (sslength ss) (setq en (ssname ss i) ent (entget en) param 0 endpar (vlax-curve-getEndParam en) i (1+ i) ) (while (< param endpar) (if (= (cdr (assoc 0 ent)) "LINE") (setq p1 (vlax-curve-getstartpoint en) p2 (vlax-curve-getendpoint en) param (1+ endpar) ) (setq p1 (vlax-curve-getPointAtParam en param) p2 (vlax-curve-getPointAtParam en (setq param (1+ param))) ) ) (setq k1 (pt->key p1) k2 (pt->key p2) graph (update-g graph k1 p1 p2) graph (update-g graph k2 p2 p1) ) ) ) (setq minD 1.7e308) ; Initialize to infinity (foreach entry graph (if (< (setq d (distance (cadr entry) Startp)) minD) (setq minD d sNode entry) ) ) (setq sKey (car sNode) openH (heap:new (length graph)) gScore (list (cons sKey 0.0)) cameFrom nil found nil ) (heap:push openH (distance (cadr sNode) Endp) (cadr sNode)) (setq gbti (- (getvar 'MILLISECS) ti)) ;Start of Pathfinding... (while (and (> #Hptr 0) (not found)) (setq cur (heap:pop openH) curPt (cdr cur) curK (pt->key curPt) ) (if (< (distance curPt Endp) 0.1) (setq found T) (foreach neighbor (cddr (assoc curK graph)) (setq nKey (pt->key neighbor) val (assoc curK gScore) t_g (+ (cdr val) (distance curPt neighbor)) ) (if (or (null (setq oldG (assoc nKey gScore))) (< t_g (cdr oldG))) (progn (if oldG (setq gScore (vl-remove oldG gScore))) (setq gScore (cons (cons nKey t_g) gScore)) (if (setq oldCF (assoc nKey cameFrom)) (setq cameFrom (subst (cons nKey curPt) oldCF cameFrom)) (setq cameFrom (cons (cons nKey curPt) cameFrom)) ) (heap:push openH (+ t_g (distance neighbor Endp)) neighbor) ) ) ) ) ) ;; Result Handling (if found (progn (setq path (list curPt) k curK ) (while (setq link (assoc k cameFrom)) (setq pt (cdr link) k (pt->key pt) path (cons pt path) ) ) (mk_3dp path) ) (princ "\nNo path found.") ) (vla-endundomark #acdoc) (setq totaltime (- (getvar 'MILLISECS) ti)) (princ "\n ----- A* Optimized With Gemini ----- ") (princ (strcat "\n Graph Size: " (itoa (length graph)) " nodes")) (princ (strcat "\n Graph Building Time: " (itoa gbti) " ms.")) (princ (strcat "\n Pathfinding Time: " (itoa (- totaltime gbti)) " ms.")) (princ (strcat "\nTotal Execution time: " (itoa totaltime) " ms.")) (*error* nil) ) ;; ; ;; ERROR HANDLING & SYSTEM UTILITIES ; ;; ; ;; ; ;; set_errhandler by Elpanov Evgenyi ; ;; Captures system variable states into global #varl. ; ;; Argument 'l': List of strings naming system variables. ; ;; ; (defun set_errhandler (l) (setq #varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) l)) ) ;; ; ;; *error* by Elpanov Evgenyi ; ;; Redefines the *error* function and display an error message. ; ;; Restores system variables and handles exit messages. ; ;; ; (defun *error* (msg) (mapcar 'eval #varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (princ) ) ;; ; ;; Heap Abstraction Utilities Using Safearray ; ;; ; ;; ; ;; heap:new ; ;; ; ;; Initializes a Variant Safearray as a Minimum-Heap and set the Heap pointer ; ;; Global Var #Hptr to 0 ; ;; ; ;; Argument: size, Total capacity for the Heap. ; ;; ; ;; Return : Safearray Object ; ;; ; (defun heap:new (size) (setq #Hptr 0) (vlax-make-safearray vlax-vbVariant (cons 0 (max 1 (1- size))) '(0 . 1)) ) ;; ; ;; heap:get ; ;; ; ;; Fetch node data at given index in the heap ; ;; ; ;; Arguments: h, Heap name as a safearray object ; ;; idx, Index of the node ; ;; ; ;; Returns: A dotted pair, (Priority . Point) ; ;; ; (defun heap:get (h idx) (cons (vlax-variant-value (vlax-safearray-get-element h idx 0)) (vlax-safearray->list (vlax-variant-value (vlax-safearray-get-element h idx 1))) ) ) ;; ; ;; heap:set ; ;; ; ;; Writes priority and point into heap at index. ; ;; Arguments: h, heap name ; ;; i, index ; ;; prio, double ; ;; p, point. ; ;; ; (defun heap:set (h i prio p / arr) (setq arr (vlax-make-safearray vlax-vbDouble '(0 . 2))) (vlax-safearray-fill arr (mapcar 'float p)) (vlax-safearray-put-element h i 0 (vlax-make-variant prio vlax-vbDouble)) (vlax-safearray-put-element h i 1 arr) ) ;; ; ;; heap:swap ; ;; ; ;; Swaps two elements the heap ; ;; ; ;; Arguments: h, heap name ; ;; i, index of first element ; ;; j, index of second element ; ;; ; (defun heap:swap (h i j / tp tv) (setq tp (vlax-safearray-get-element h i 0) tv (vlax-safearray-get-element h i 1) ) (vlax-safearray-put-element h i 0 (vlax-safearray-get-element h j 0)) (vlax-safearray-put-element h i 1 (vlax-safearray-get-element h j 1)) (vlax-safearray-put-element h j 0 tp) (vlax-safearray-put-element h j 1 tv) ) ;; ; ;; heap:push ; ;; Adds a node, re-sorts heap via sift-up and adjust the heap pointer ; ;; ; ;; Arguments: h, heap name ; ;; prio, priority ; ;; pt, point ; ;; ; ;; Returns: Value of heap pointer ; ;; ; (defun heap:push (h prio pt / i p) (heap:set h #Hptr prio pt) (setq i #Hptr) (while (and (> i 0) (< prio (car (heap:get h (setq p (/ (1- i) 2)))))) (heap:swap h i p) (setq i p) ) (setq #Hptr (1+ #Hptr)) ) ;; ; ;; heap:pop ; ;; ; ;; Removes root node, re-sorts the heap by sift-down updates #Hptr ; ;; ; ;; Argument: h, heap name ; ;; ; ;; Return: root node as dotted pair (Priority . Point) ; ;; ; (defun heap:pop (h / root size i l r s i-prio l-prio r-prio) (if (> #Hptr 0) (progn (setq root (heap:get h 0) #Hptr (1- #Hptr)) (if (> #Hptr 0) (progn (heap:swap h 0 #Hptr) (setq i 0 size #Hptr) (while (< (setq l (1+ (* i 2))) size) (setq r (1+ l) ;; Get priorities once to avoid redundant safearray lookups i-prio (vlax-variant-value (vlax-safearray-get-element h i 0)) l-prio (vlax-variant-value (vlax-safearray-get-element h l 0)) s l ) ;; Check if right child exists and is smaller than left (if (and (< r size) (< (setq r-prio (vlax-variant-value (vlax-safearray-get-element h r 0))) l-prio)) (setq s r l-prio r-prio)) ;; Update smallest index and priority ;; If smallest child is smaller than current, swap (if (< l-prio i-prio) (progn (heap:swap h i s) (setq i s)) (setq i size)) ;; Else, heap property restored ) ) ) root ) ) ) ;; ; ;; GRAPH & DRAWING UTILITIES ; ;; ; ;; ; ;; pt->key ; ;; Converts 3D point to a string key "X,Y,Z". ; ;; Argument 'p': 3D point list. ; ;; ; (defun pt->key (p) (strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2) " " (rtos (caddr p) 2 2))) ;; ; ;; update-g ; ;; Links nodes in graph association list. ; ;; ; ;; Arguments: g, graph list ; ;; k, key ; ;; p, point ; ;; n, neighbor. ; ; ;; ; (defun update-g (g k p n / ex) (if (setq ex (assoc k g)) (subst (append ex (list n)) ex g) (cons (list k p n) g) ) ) ;; ; ;; mk_3dp by Alan J Thompson ; ;; ; ;; Entmakes a 3D Polyline. Global Vars #Pathlay, #Pathcol and #Pathlwt have ; ;; to be set in calling program. ; ;; ; ;; Argument: lst, List of 3D points. ; ;; ; ;; Returns: Entity Name of Polyline ; ;; ; (defun mk_3dp (lst / vtx) (if (and lst (> (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) ) ) ) (entmakex '((0 . "SEQEND"))) ) ) ) (defun mk_circle (ctr rad color) (entmakex (list (cons 0 "CIRCLE") (cons 10 ctr) (cons 40 rad) (cons 8 #Pathlay) (cons 62 color) (cons 370 #Pathlwt) ) ) ) (princ "\nCommand A* loaded.") (princ) Astar3dHeap.LSP

If you use Al Roger's old Lisp code to draw structural shapes (STL.LSP), I have replaced his old 9th Edition AISC shapes with the latest 16th edition shapes. I left his data for the Metric shapes alone since I did not have a source for the dimensions. His Lisp routine reads several DIM files that contain the shape data and I have not touched it. I just replaced his old DIM files with new ones. When I did the DIM files for the 13th edition of AISC, I kept Al's old data and appended a 9th on the end of the shape name and the 13th edition was added onto the end of the data. IIRC, the AISC has a spreadsheet with very old profiles for steel shapes from the late 1800's and the motivated user could add the old shapes at the end of the DIM files. The 16th edition of the AISC shape data includes many new rolled sizes. In order to use the Lisp, you have to unzip the package into a folder in your search path where it loads your LSP files and all the DIM files must be in the same folder so his program can find them along with the help file. I tested the program out on my 2024 version of ACAD and have used it on all prior ACAD versions that I've used for many years. For new users, after you Load the Lisp, you just type STL and his dialog window pops up and you select the shape and size and the 2D End, 2D Top, 2D Side, 3D Sold, or 3D Surface, and the Lisp will draw the shape. I'm a Structural Engineer and use STL to draw the shapes to see if the shape is too close to the anchor bolts on my base plate design. I don't do much drafting and not much Lisp, so I am in awe of the talent that came up with this code. I just occasionally edit the DIM files so it can draw new shapes. Edit--Edit-- I found an error in the Stl_Tube.DIM file and it was corrected with the revised ZIP below. I also edited the DCL file to change the Label for Tubes to HSS which is what the AISC now calls them. I found another error in the LSP code with a divide by 2 producing errors (it should have been /2.0) ) HTH Al's Steel Mill 2023_R1.zip

https://github.com/mapbox/concaveman https://github.com/sadaszewski/concaveman-cpp it’s not automatic in that it requires parameters depending on the point distribution. concavity: A relative measure of concavity. A value of 1 provides a detailed shape, while Infinity results in a convex hull. lengthThreshold: Determines the minimum segment length considered for further detailing, with higher values leading to simpler shapes. Chomped through this 280k point set import traceback from pyrx import Ap, Db, Ed, Ge # --- Command for PyRx --- @Ap.Command() def doit0(): try: ps, ss = Ed.Editor.select([(Db.DxfCode.kDxfStart, "POINT")]) pnts = Ge.Point3dArray([Db.Point(id).position() for id in ss]) hull_points = pnts.concaveHull(0.8, 100) db = Db.curDb() pl = Db.Polyline(hull_points) pl.setDatabaseDefaults() pl.setClosed(True) pl.setColorIndex(2) db.addToModelspace(pl) except Exception: traceback.print_exc()

This is a great guide working with Delaunator. https://mapbox.github.io/delaunator/ It explains the relationship between half-edges and triangles. in short the triangles are created in an order, you can iterate the triangles while being aware of the adjacent triangles. A [-1] in the half edge list means that edge is on the outside hull.

The algorithm is fast because it returns a list of indexes, to your original array, of the points that make up the triangle, it also returns a list of half edges from pyrx import Ap, Db, Ed, Ge, Gi import traceback @Ap.Command() def doit(): try: filter = [(Db.DxfCode.kDxfStart, "POINT")] ps, ss = Ed.Editor.selectPrompt( "\nSelect points: ", "\nRemove points: ", filter ) if ps != Ed.PromptStatus.eNormal: return pnts = Ge.Point3dArray([Db.Point(id).position() for id in ss]) d = Ge.Delaunator(pnts) print(d.triangles()) print(d.halfedges()) except Exception: print(traceback.format_exc()) [0, 4, 3, 2, 1, 0, 0, 1, 4, 3, 2, 0] [8, -1, 11, -1, 6, 10, 4, -1, 0, -1, 5, 2]

solution from the Autodesk forums "*^C^C^C_dimangular;;non;0,0;non;0,1;\NON"

Resetting to default definitely works as a 'nuclear' option, but for anyone else finding this thread who doesn't want to lose their UI setup, definitely check PICKFIRST and PICKADD first. If those variables get flipped to 0 by a glitch or a rogue LISP routine, it causes exactly this behavior where the Properties palette won't 'see' your selection.

I think a custom DCL front end would be good. Will have a think about it. The extend option is easy just set the default length to 0.0 so any other value means yes. Nikon the dynamic block is a nice idea.

Like @Steven P "Generally I save to the same folder as the CAD file" In the attached file is a plot a range of pdf's a DCL pops up for the range then the plots are done. In the code you will see a command Mk-dir that is used to make a PDF directory. I think we have discussed previously about making menu's as the simplest way of click on a choice and it happens. See image above, keep adding options for users, they don't need to worry about appload or (load."????") I had 8 users, our menu was on a server so would auto update for end users. You will need to change the code to suit your title block and pdf settings have a go. It is set up for title block at 0,0. It is possible to have one lisp but it uses different variables for different output devices and title blocks. A version I have for a client looks at title block name and sets the correct plot size settings. Come back if have a problem, you have my Email ? plotA3Pdfrange.lsp Multi GETVALS.lsp

You need to understand what is a OEM version it is used by software providers as a means to get an Autocad but with their software as the essential item. Refering to OEM document "Deliver products with scaled feature sets at scaled price points and provide an AutoCAD-based platform that cannot be customized or extended by end users." So any outside program lisp or .NET etc can not be ran by you. But you can add programs using the OEM key that is held by the software developer. You would have to go back to them to add. What program did you buy ?

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

Are you using a localized version of AutoCAD? Try this option. ; By Alan H AUG 2019 / modification ; offset sides pline.lsp - original ; draw offsets from points for random shape object making pline ; https://www.cadtutor.net/forum/topic/98954-smart-offset-lisp/ ; Added characters (_) for localized versions of Autocad. ; You select the points sequentially, and the program draws the offsets. Right-right-down / Left-left-up ; Be sure to press Enter or rmb (right mouse button) to complete the selection of points, ; this way, the program will smooth out all the offset segments (i.e. combine them into a polyline). ; added memorization of the last offset distance selection ; Added backlight for selecting [Right/Left], [Swap sides] (defun c:ploffs-m (/ offdir offd x pt1 pt2 pt3 oldsnap ssp) (defun drawline (/ ang pt3 obj) (setq ang (angle pt1 pt2)) (if (= offdir "L") (setq pt3 (polar pt2 (+ ang (/ pi 2.0)) 10)) (setq pt3 (polar pt2 (- ang (/ pi 2.0)) 10)) ) (setvar 'osmode 0) (command "_.line" pt1 pt2 "") (setq obj (entlast)) (command "_.offset" offd obj pt3 "") (setq ssp (ssadd (entlast) ssp)) (command "_.erase" obj "") (setq pt1 pt2) ) (defun swapr-l (/) (if (= (strcase offdir) "L") (setq offdir "R") (setq offdir "L") ) (setvar 'osmode oldsnap) (setq pt1 (getpoint "\nPick next point")) (setq pt2 (getpoint "\nPick next point")) (drawline) ) ; add side pick (setq oldsnap (getvar 'osmode)) (setq ssp nil) (initget 6 "R L") ; (setq offdir (strcase (getstring "Right or Left"))) (setq offdir (strcase (getstring "[Right/Left]"))) ;; --- remember last offset distance --- (if (not (boundp '*lastOffD*)) (setq *lastOffD* (if (getenv "MY_LAST_OFFD") (atof (getenv "MY_LAST_OFFD")) 10.0 ; (offset distance By default) ) ) ) (setq offd (getreal (strcat "\nEnter offset distance <" (rtos *lastOffD* 2 4) ">: "))) (if (null offd) (setq offd *lastOffD*) (progn (setq *lastOffD* offd) (setenv "MY_LAST_OFFD" (rtos offd 2 8)) ) ) ;; --- /remember last offset distance --- (setq pt1 (getpoint "pick 1st point")) (setq ssp (ssadd)) (initget 6 "1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z") (while (setq pt2 (getpoint "\nPick next point or [Swap sides]:<")) (cond ((= (type pt2) 'LIST) (drawline)) ((= (type pt2) 'str) (swapr-l)) ; also calls drawlines ((= pt2 nil) (quit)) ) (setvar 'osmode oldsnap) (initget 6 "Swap") ) (setq x 0) (repeat (- (sslength ssp) 1) (setvar 'filletrad 0) (command "_.fillet" (ssname ssp x) (ssname ssp (1+ x))) (setq x (1+ x)) ) (setq x 0) (command "_.pedit" (entlast) "_Y" "_J") ; if "Join" doesn't work, try the line below without the "_Y" ;(command "_.pedit" (entlast) "_J") (repeat (- (sslength ssp) 1) (command (ssname ssp x)) (setq x (1+ x)) ) (command "" "") (princ) )

Steps after typing STL at the prompt to start the program: 1) Select the Shape button (in your screen shot you selected Pipe-Std 2) Select the View you want (2d end etc.) 3) Select the size from the drop down Size table. 4) The OK button will now be available, and you select OK. 5) The dialog box will go away and you select a point on your drawing to start the shape. Each shape has a different starting point. 6) Doubly symmetric shapes like pipes will draw the shape 7) Singly symmetric shapes like angles will put the shape in and you can rotate it as you like dynamically. 8 ) To draw another shape, you type in STL again and repeat as needed.