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

Here's an old one CAB wrote. dz.lsp

I am not good as the others but try this. It will build what you want to achieve but not exactly as what was shown in the image. Maybe other can improve the code. (defun c:LayerLegend (/ doc lays lay laylist layname laycolor laydesc pt x y starty rowH txtH headH colHT col1 col2 col3 totalH legendBlock w) (defun GetTextWidth (txt height / doc ms txtObj minp maxp w) (if (or (not txt) (= txt "")) 0 (progn (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq ms (vla-get-ModelSpace doc)) ;; create temp text off-screen (setq txtObj (vla-AddText ms txt (vlax-3d-point -1000 -1000 0) height)) ;; initialize safearrays (setq minp (vlax-make-safearray vlax-vbDouble '(0 . 2))) (setq maxp (vlax-make-safearray vlax-vbDouble '(0 . 2))) ;; get bounding box safely (vl-catch-all-apply '(lambda () (vla-GetBoundingBox txtObj 'minp 'maxp) )) ;; width in X direction (setq w (abs (- (vlax-safearray-get-element maxp 0) (vlax-safearray-get-element minp 0)))) ;; delete temp text (vla-Delete txtObj) w ) ) ) (vl-load-com) (setq rowH 8.0) (setq txtH 2.0) (setq headH 2.5) (setq colHT 1.0) (setq col1 35.0) ;; fixed column 1 width (setq col2 50.0) ;; fixed column 2 width (setq col3 65.0) ;; fixed column 3 width (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq lays (vla-get-Layers doc)) (setq laylist '()) (vlax-for lay lays (setq layname (vla-get-name lay)) (setq laydesc (if (vlax-property-available-p lay 'Description) (vla-get-description lay) "")) ;; Skip 0, Defpoints, XREF (if (and (/= layname "0") (/= (strcase layname) "DEFPOINTS") (not (vl-string-search "|" layname))) (progn (setq laycolor (vla-get-color lay)) (setq laylist (cons (list layname laycolor laydesc) laylist)) ) ) ) (setq laylist (vl-sort laylist '(lambda (a b) (< (strcase (car a)) (strcase (car b)))) ) ) (if (setq legendBlock (tblsearch "BLOCK" "LAYERLEGEND_MARK")) (command "_.erase" "B" "LAYERLEGEND_MARK" "") ) (setq pt (getpoint "\nPick insertion point: ")) (setq x (car pt)) (setq y (cadr pt)) (setq starty y) (setq totalH (* rowH (+ (length laylist) 1))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list (+ x col1 col2 col3) starty 0)))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x 3) (- y 5) 0)) (cons 40 headH) (cons 1 "COLOR NUMBER"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 3) (- y 5) 0)) (cons 40 headH) (cons 1 "LAYER NAME"))) (entmakex (list '(0 . "TEXT")(cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 5) 0)) (cons 40 headH) (cons 1 "DESCRIPTION"))) ;; header bottom line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) (foreach L laylist (setq layname (nth 0 L)) (setq laycolor (nth 1 L)) (setq laydesc (nth 2 L)) ;; Color number text (1 mm) on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x 3) (+ y -2.2) 0)) (cons 40 colHT) (cons 1 (itoa laycolor)))) ;; Sample line on its layer (entmakex (list '(0 . "LINE") (cons 8 layname) (cons 10 (list (+ x 3) (- y 3) 0)) (cons 11 (list (+ x col1 -3) (- y 3) 0)))) ;; Layer name text on its layer (entmakex (list '(0 . "TEXT") (cons 8 layname) (cons 10 (list (+ x col1 3) (- y 4) 0)) (cons 40 txtH) (cons 1 layname))) ;; Description text (Layer 0) (entmakex (list '(0 . "TEXT") (cons 8 "0") (cons 10 (list (+ x col1 col2 3) (- y 4) 0)) (cons 40 txtH) (cons 1 laydesc))) ;; Row horizontal line (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x (- y rowH) 0)) (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0)))) (setq y (- y rowH)) ) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list x starty 0)) (cons 11 (list x (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1) starty 0)) (cons 11 (list (+ x col1) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2) starty 0)) (cons 11 (list (+ x col1 col2) (- starty totalH) 0)))) (entmakex (list '(0 . "LINE")(cons 8 "0") (cons 10 (list (+ x col1 col2 col3) starty 0)) (cons 11 (list (+ x col1 col2 col3) (- starty totalH) 0)))) (princ) )

Nice program as always Tharwat. I think what the OP need is create a table as attached for visual reference.

I would ask that you delete your drawings. Why? Because another student could come along and borrow them, make minor changes then submit them as their own drawings thus saving hours of labor. You do all the work and they get the credit. Not kosher at all. Follow me? Addendum: Looks like someone has already done exactly that. Again, take your drawings down. There are plenty of image files (not CAD files for students) to reference. Thank you.

Here's my program : https://autolispprograms.wordpress.com/create-layers-from-excel-file/

This is what I use, I think the root LISP is the same as the OPs, over time I have added to it: txtfindreplace ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/find-and-replace-text/td-p/5649883 (defun FindReplace (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen# acount) (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$) ) (setq acount 0) (while Loop (setq Mid$ (substr NewStr$ Cnt# FindLen#)) (if (= Mid$ Find$) (progn (setq acount (+ acount 1)) (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#))) Cnt# (+ Cnt# ReplaceLen#) );setq );end progn (setq Cnt# (1+ Cnt#)) );if (if (= Mid$ "") (setq Loop nil)) );while (list NewStr$ acount) );defun FindReplace (defun FindReplaceNew (Find$ Replace$ / SS acounter acount ent1 entlist1 entcodes1 EntType Text$ text01 ReplaceWith$ FoundReplaced NewTxt MyBlockEntList BlockCounter ) ;;;Sub Routines ;;;; ;;;;;;;;;;;;;;;;;;;; ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-entities-inside-a-block/td-p/2644829 (defun getblkitems ( EntName / sel items) ;;Blocks: (setq nfo (entget EntName)) (progn (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object) ) ) (cdr (assoc 2 nfo)) ) (setq items (cons (vlax-vla-object->ename item) items)) ) ;end vlax ) ; end progn ) ;end defun (defun updateblock ( EntType ent1 entlist1 acount Find$ Replace$ / MyBlockEntList BlockCounter EntType2 ent2 entlist2 ) (if (= EntType "INSERT") (progn ;;Updates block texts & block blocks (setq MyBlockEntList (getblkitems ent1) ) (setq BlockCounter 0) (while (< BlockCounter (length MyBlockEntList)) (setq ent2 (nth BlockCounter MyBlockEntList)) (setq entlist2 (entget ent2)) (setq EntType2 (cdr (assoc 0 entlist2)) ) ;;Attrributes (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$)) ;;Texts (if (or (= EntType2 "TEXT")(= EntType2 "MTEXT")(= EntType2 "MULTILEADER")) ;;attributes? (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ); end if ;;Changes Dimensions (if (or (= EntType2 "DIMENSION") ) (if (= (cdr (assoc 1 entlist2)) "") ;;if has text over ride () (progn (setq acount (updatetext EntType2 ent2 entlist2 acount Find$ Replace$)) ;;same as text -if- ent code 4 used (command ".-refedit" (cdr (assoc 10 entlist1)) "ok" "all" "yes") ;;update block definition (command "refclose" "s") );end progn ) ;end if ); end if (if (= EntType2 "ACAD_TABLE") (setq acount (UpdateTable EntType2 ent2 entlist2 acount Find$ Replace$)) );end if (if (= EntType2 "INSERT") ;;Blocks (setq acount (updateblock EntType2 ent2 entlist2 acount Find$ Replace$)) );end if (setq BlockCounter (+ BlockCounter 1)) ) ; end while );end progn );end if acount ) ;;End Blocks ;;;;;;;;;;;;;;;;;;;; (defun updateattribvalues (EntType ent1 entlist1 acount Find$ Replace$ / ) (setq EntName^ ent1 EntList@ entlist1 EntType$ EntType Text$ (cdr (assoc 1 EntList@)) );setq (if (= EntType$ "INSERT") (if (assoc 66 EntList@) (progn (while (/= (cdr (assoc 0 EntList@)) "SEQEND") (setq EntList@ (entget EntName^)) (if (= (cdr (assoc 0 EntList@)) "ATTRIB") (progn (setq Text$ (cdr (assoc 1 EntList@))) (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq FoundReplaced (FindReplace Text$ Find$ Replace$)) (setq ReplaceWith$ (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );progn );end if attrib (setq EntName^ (entnext EntName^)) );while );progn );if );if acount ) ;end defun ;;;;;;;;;;;;;;;;;;;; (defun updatetext (EntType ent1 entlist1 acount Find$ Replace$ / entcodes1 FoundReplaced NewTxt) (progn (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text. (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string (if (= text01 nil) () (progn (setq FoundReplaced (FindReplace text01 Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (addinnewtext NewTxt entlist1 ent1) )) ;end progn, end if ) ; end progn acount ) ;;;;;;;;;;;;;;;;;;;; (defun UpdateTable ( EntType ent1 entlist1 acount Find$ Replace$ / text01 Newentlist1 counter) (setq counter 0) (setq Newentlist1 '()) (while (< counter (length entlist1)) (if (or (= (nth 0 (nth counter entlist1)) 1)(= (nth 0 (nth counter entlist1)) 302) ) (progn (setq text01 (cdr (nth counter entlist1))) (setq FoundReplaced (FindReplace text01 Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (setq text01 NewTxt) (setq Newentlist1 (append Newentlist1 (list (cons (nth 0 (nth counter entlist1)) text01)))) ) ;end progn (setq Newentlist1 (append Newentlist1 (list (nth counter entlist1)))) ;;ignore entity item ) ;end if (setq counter (+ counter 1)) ) ;end while (setq entlist1 Newentlist1) (entmod entlist1) (entupd ent1) acount ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;end subroutines 'findreplace' (setq acount 0) (setq acounter 0) (command "UNDO" "BEGIN") (setq SS (ssget "x" (list '(-4 . "<AND") '(-4 . "<OR") '(0 . "*TEXT") '(0 . "INSERT") '(0 . "ATTDEF") '(0 . "ATTRIB") '(0 . "DIMENSION") '(0 . "*LEADER") '(0 . "POSITIONMARKER") '(0 . "*TABLE") '(-4 . "OR>") (cons 410 (getvar "CTAB")) '(-4 . "AND>") ))) ; end setq, end ss, end list ;;;FILTER SS to text string (while (< acounter (sslength SS)) (setq ent1 (ssname SS acounter)) (setq entlist1 (entget ent1)) (setq EntType (cdr (assoc 0 entlist1)) ) (setq Text$ (cdr (assoc 1 entlist1)) ) ;;change this line to get all texts inc. long texts etc. ;;Changes Attribute Values - In Blocks (setq acount (updateattribvalues EntType ent1 entlist1 acount Find$ Replace$)) ;;Changes Block Texts (if (= EntType "INSERT") (setq acount (updateblock EntType ent1 entlist1 acount Find$ Replace$)) );end if ;;Changes Texts (if (or (= EntType "MTEXT")(= EntType "TEXT") (= EntType "MULTILEADER") (= EntType "POSITIONMARKER") ) (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ); end if (if (or (= EntType "DIMENSION") ) (if (= (cdr (assoc 1 entlist1)) "") ;;if has text over ride () (setq acount (updatetext EntType ent1 entlist1 acount Find$ Replace$)) ;;same as text -if- ent code 4 used ) ); end if (if (or (= EntType "ATTDEF")(= EntType "ATTRIB") ) (progn (setq ent2 (entget ent1)) (setq AttText (cdr (assoc 2 ent2))) (setq FoundReplaced (FindReplace AttText Find$ Replace$)) (setq NewTxt (nth 0 FoundReplaced)) (setq acount (+ acount (nth 1 FoundReplaced))) (setq newval Replace$) (entmod (subst (cons 2 NewTxt) (assoc 2 ent2) ent2)) (entupd ent1) );end progn ); end if (if (= EntType "ACAD_TABLE") (setq acount (UpdateTable EntType ent1 entlist1 acount Find$ Replace$)) );end if (setq acounter (+ 1 acounter)) ) ; end while (command "REGEN") (command "UNDO" "END") acount );defun FindReplaceNew (defun c:txtFindReplace( / old_text new_text) (setq old_text (getstring T "OLD Text to replace (replace in this model/paper space and text case as entered): ")) (setq new_text (getstring T "NEW Text: ")) (princ "Changes: ") (princ (FindReplaceNew old_text new_text) ) (princ) )

The OP seems to have exited the conversation, but just for others with the same inquiry. As I have mentioned, this is mostly an issue with your PDF editor, the instructions for using the OCR should be in Foxit Help. If this is something you need to do going forward without any effort, you need to use TTF.

As most of us use Microsoft Office products I switched from using AutoCAD's Swiss Lt BT TrueType font to ArialNarrow.ttf like SLW210 suggested as it's horizontally compressed to take up less space while being even more easily readable. While hindsight doesn't fix your immediate problem finding a font that doesn't cause issues with your PDF software before you need to output one to PDF again would solve your issues in the future. I've struggled with the same issue even with the full paid version of Adobe with drawings by others usually because of SHX text with various width factors. Never do that with a DWG you want to output to PDF unless you don't want anyone to convert that text back again.

I opened your PDF in Acrobat Pro and the text was editable. This seems to be a Foxit issue, though as mentioned, you might want to use a TTF font if that's what Foxit needs. ArialNarrow.ttf is a common replacement IIRC to ISOCP.shx

We talk a lot about speed but does it matter, if it take seconds or a minute, a task I worked on could take up to 3 hours manually it takes 2 minutes now. I improved the speed 3 times by recoding. Yes if have thousands of lines go get a coffee. still faster than having a go manually. I guess what I am saying are we talking seconds, minutes or hours ? 13 seconds for 5000, I would call that fantastic. If worried about time add a progress bar it's a Acet function. The task above started at like 25 minutes to do, so 2 minutes as final version is considered acceptable by me. Yes talking thousands of changes.

As @Steven P suggested you can have as many plot predefined settings as you want. Did you test the "getpropertyvalue" code in your LT as per my request above. I don't have LT so can not test.

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) )

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

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.

Thanks!! it's working fine. It's okay if it's not exactly the same from mine but as long as it can generate the table it's fine. saved me a lot of time.

Thank you I can use this as well...

yah it is... I overlooked it. All good now.

Gotcha, thx Remark

not sure what your trying to do. you can set entlast before the explode then add all the entities into the selection set. (setq LastEnt (entlast)) (command "_.explode" ss) (setq SS1 (ssadd)) ;create a blank selection set or add to an existing one. (while (setq LastEnt (entnext LastEnt)) (ssadd LastEnt SS1) )

I tried this as a test, so finds the #1234 text. It will find 123#456 also. But the lisp as suggested by @Steven P should cater for that. (setq ss (ssget "X" (list (cons 0 "*text")(cons 1 "*#*")))) (princ (sslength ss)) 12

Why not just use the built-in FIND command in AutoCAD? You just have to turn off the "Use Wildcards" option.

Have a go at adding this vehicle, they are daunting when you meet them on the road. Let alone the 3 x 19m petrol tankers. Recording 2026-03-01 183700.mp4

Such a tool would be https://www.theswamp.org/index.php?topic=58808.0

Unfortunately not with the current version, but I'll certainly consider implementing this functionality in a future version.

Have you tried to turn off Object Snaps before you run the script? It looks to me as if your line is snapping to adjacent end of line points instead of plotting the listed coordinates.

I moved your thread to the The CUI, Hatches, Linetypes, Scripts & Macros Forum. Your script is missing the blank line at the bottom, so it needed that for enter at the end. Other than that, I ran it in AutoCAD 2000i on my home computer and they all look like your bottom image.

Just doing something wrong with using OBDX still getting my head around using it. I think the limitation is in getting an object via a selection set. So a script approach may be the easiest way. Give this a try two parts the doatts.lsp file which does the work, the c:doatts that makes the script to be run so need to load that first. That means 2 lisp files. Change the Acadtemp to your start directory, pick any dwg for directory name. (defun c:doatts ( / fname files pre fo) (setq fname (getfiled "Select a Dwg FILE" "d:\\Acadtemp" "dwg" 16)) ; chnage start directory name (setq pre (car (fnsplitl fname))) (setq files (vl-directory-files pre "*.DWG" 0)) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".scr")) "w")) (write-line "(command \"regen\")" fo) (foreach file files (write-line (strcat "Open " "\"" pre file "\"") fo) (write-line "(load \"doatts\")" fo) (write-line "(AH:doatts)" fo) (write-line "close Y" fo) ) (close fo) (command "script" fname) (vl-file-delete fname) (princ) ) Second lisp is the doatts defun AH:doatts ( / ss obj atts att tname) (setq ss (ssget "X" '((0 . "INSERT")))) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (1- x))))) (if (= (vlax-property-available-p obj 'hasattributes) T) (progn (setq atts (vlax-invoke obj 'Getattributes)) (foreach att atts (setq tname (vlax-get att 'Tagstring)) (if (= tname "MATERIAL") (vlax-put att 'Textstring "TEST") ) ) ) ) ) (command "close" "Y") (princ) )

In PDF-XChange Editor, I could only edit the Title Border Text. All the node text isn't editable. Using OCR in PDF-XChange, it converted all 5 pages in about 15 seconds. I am using the paid-for version, so not sure if OCR is available in the free version.

Just do a google you should be able to find a ISO.TTF font there are thousands of fonts out there. You open c:\Windows\fonts and drag the TTF onto it from memory. ISO3098B ? If your lucky some one may have one already.

Like a lot here just remember teaching your children how to drive, no did not crash into things, but went around a roundabout, hands everywhere trying to turn, change gears and me praying as we chugged out.

Can you post a sample drawing with a block example of before & after? Add explanatory notes to the drawing so that we understand. From what I can understand of your goal I think Lee's code will work without modification.

I can do that most of the time with the OCR (Optical character recognition) in Adobe Acrobat Pro. I thought Foxit has an OCR.

You may not have a choice here, but can you convert your text to TTF from SHX? PDF should accept that as text.

Took the day yesterday to work through the examples, youtube and so on, a bit of trial and error and kid of got it working. Just need to practice more - it wasn't as bad as it looked at first Driving however is another thing. Still crashing into things.

You have a Table in your images, you can change all or one cell in a table with respect to the font style. Is that what your asking for ? If so post an example table dwg. Something like this (vla-SetTextStyle Objtable (+ acDataRow) "Arial") in a lisp.

There are several LISP programs around for stripping MTEXT. Solved: strip mtext formatting - Autodesk Community Re: StripMText Issue - Autodesk Community In the MText Editor there is a down arrow on the top right, scroll down to Remove Formatting.

Thanks Tombu, played a little this morning and demolished some of a virtual London, not the software, my driving skills... but your links look handy

I use a block with mask/wipeout, scaled up, then xclipped to trim the extent of lines. Allows easy moving and 'breaking' of hatch patterns without actually breaking anything. sym-breakline-mask.dwg

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 ?

A small modification of the DZ code for convenience. The Break lines can be lengthen by the specified distance (Fixed) or proportionally (by 1/3) or None. [Fixed/Proportional/None] ;;; Lisp to draw Single or Double "Z" Break Lines ;;; © A.Henderson 2002 ;;; Modified By Charles Alan Butler 10/06/2004 ;;; To allow any angle and to trim lines that ;;; do not run through both break symbols ;;; Modified 12/02/26 ;;; The Break lines can be lengthen by the specified distance (Fixed) ;;; or proportionally (by 1/3) or None (defun c:dz-mod (/ oldlay oldotho oldosmode ztype dist ang extOpt extLen dist0 segLen e1 e2 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10) ;; return vertex list by MP (defun cdrs (key lst / pair rtn) (while (setq pair (assoc key lst)) (setq rtn (cons (cdr pair) rtn) lst (cdr (member pair lst)) ) ) (reverse rtn) ) ; defun ;; set osnaps ON/OFF (defun setosnaps (value) ; value = "ON" or default to "OFF" (if value (setq value (strcase value)) ) (cond ((or (and (= value "ON") (>= (getvar "osmode") 16383)) (and (/= value "ON") (<= (getvar "osmode") 16383)) ) (setvar "osmode" (boole 6 (getvar "osmode") 16384)) ) ) ); defun ;; Start of routine ================================== ;; Save settings (setq oldlay (getvar "clayer") oldortho (getvar "orthomode") oldosmode (getvar "osmode") ) ;_ end of setq ;; I use current layer - CAB ;;(command "_.layer" "_make" "Z-Line" "_Colour" "41" "" "") (initget "S D") ;(setq ztype (getkword "\n Single or Double -^v-^v- ? (S or D) <S>")) (setq ztype (getkword "\n Single or Double -^v-^v- ? [S/D] <S>")) (setosnaps "ON") ; force on ;;=========================================== (if (and (setq p1 (getpoint "Starting point of break line : ")) (setq p6 (getpoint p1 "End point of break line : ")) ) (progn;=========================================== ;;; --- EXT --- calculate the base length/angle based on the selected points (setq dist0 (distance p1 p6)) ;;; --- EXT --- elongation mode (Fixed = 50 by default) (initget "F P N") (setq extOpt (getkword "\nExtend beyond picked points? [Fixed/Proportional/None] <Fixed>: ")) (cond ((or (not extOpt) (= extOpt "F")) (setq extLen (getdist "\nExtension length <50>: ")) (if (null extLen) (setq extLen 50.0)) ) ((= extOpt "P") ;; 1/3 of the straight section (straight section = 0.4167*dist for S, and 0.4167*(dist/2) for D) (setq segLen (* 0.4167 (if (= ztype "D") (/ dist0 2.0) dist0))) (setq extLen (/ segLen 3.0)) ) (T (setq extLen 0.0)) ) (setvar "plinewid" 0) (command "._undo" "_begin") (cond ((/= ztype "D") ; default to single (setq dist (distance p1 p6) ang (angle p1 p6) p2 (polar p1 ang (* 0.4167 dist)) p5 (polar p1 ang (* 0.5833 dist)) p3 (polar p2 (+ 1.25664 ang) (* 0.1667 dist)) p4 (polar p5 (+ 4.39824 ang) (* 0.1667 dist)) ) ;_ end of setq ;;; --- EXT --- we only lengthen the ends (the symbol remains at the base points) (setq p1 (polar p1 (+ ang pi) extLen) p6 (polar p6 ang extLen) ) (setosnaps "OFF") ; force off (command "_.pline" p1 p2 p3 p4 p5 p6 "") ; Draw the Z-Line ) ;_ end cond "S" ;;=========================================== ((= ztype "D") (setq p10 p6 dist (/ (distance p1 p6) 2.0) ang (angle p1 p6) p2 (polar p1 ang (* 0.4167 dist)) p5 (polar p1 ang (* 0.5833 dist)) p3 (polar p2 (+ 1.25664 ang) (* 0.1667 dist)) p4 (polar p5 (+ 4.39824 ang) (* 0.1667 dist)) p6 (polar p5 ang (* 0.8334 dist)) p9 (polar p6 ang (* 0.1661 dist)) p7 (polar p6 (+ 1.25664 ang) (* 0.1667 dist)) p8 (polar p9 (+ 4.39824 ang) (* 0.1667 dist)) ) ;_ end of setq ;;; --- EXT --- we extend the start and the very end (p10), we do not touch the inside (setq p1 (polar p1 (+ ang pi) extLen) p10 (polar p10 ang extLen) ) (setosnaps "OFF") ; force off (command "_.pline" p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 "") ; Draw the Z-Line ) ;_ end cond ) ; end cond stmt ;; Position the second break line (setq e1 (entlast)) (command "_.pedit" e1 "_L" "_ON" "") (command "_.copy" e1 "" (getvar "lastpoint") pause) (setq e2 (entlast)) (setq plast (getvar "lastpoint")) ;; trim function (initget "Y N") (setq ans (getkword " Do you wish to trim the lines now ? [Y/N] <Y>")) (if (or (= ans "Y") (not ans)) (progn (setq lst '() dist (/ dist 140.0) ; trim distance ) ;; create trim lines (command "._offset" dist e1 plast "") (setq evl1 (cdrs 10 (entget (entlast)))) ; ent vertex list (entdel (entlast)) (command "._offset" dist e2 p1 "") (setq evl2 (cdrs 10 (entget (entlast)))) (entdel (entlast)) (setq lst (append evl1 (reverse evl2))) (setosnaps "OFF") ; force off (command "_.trim" e1 e2 "" "_F") (apply 'command lst) (command "" "") (command "_.trim" e1 e2 "" "_F") (apply 'command lst) (command "" "") ) ; progn ) ;_ endif (command "._undo" "_end") ) ; progn ) ; endif ;;================ ;; Exit sequence ;;================\ ;; Restore settings ;; I use current layer - CAB ;;(command "_.layer" "set" oldlay "") (setvar "orthomode" oldortho) (setvar "osmode" oldosmode) (princ) ) ;_ end of defun (prompt "\nDouble Break Symbol Creator loaded. Type DZ to run it." ) (princ) (setfunhelp "c:dz" "acadtools.chm" "dz")

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)

Ok its simple to use vpoint to set your view angles, code is part of a view choice lisp. (if (= look "R")(command-s "-vpoint" "1,0,0")) (if (= look "L")(command-s "-vpoint" "-1,0,0")) (if (= look "F")(command-s "-vpoint" "0,-1,0")) (if (= look "B")(command-s "-vpoint" "0,1,0")) (if (= look "P")(command-s "-vpoint" "0,0,1")) (if (= look "3")(command "_.vpoint" "-1,-1,1")) If you want auto 3 viewports then you need to ask what scale and pick say a point in model so the views can be based around that point. I would use a layout with a title block.

How to export, import, backup, and transfer settings to and from AutoCAD products Though if the old computer is unusable, you may have to just start from anew.

Call Grind for Lisp (CG) is a Lisp application aimed to help profiling of lisp programs running on IntelliCAD, AutoCAD, BricsCAD and alikes. If you are in need of determining the bottle-necks, the time consumed for specified functions , visualize call diagram of your lisp application you may find CG useful. CG collects data (time consumed by each function and call stack) at runtime (dynamic analysis) and creates “call grind” type output to be used by CacheGrind system (credit goes to authors). Requirement: Download and install qcachegrind software recompiled for Windows version of KCacheGrind. Refer to header of the lisp code attached for instructions. Limitation: May fail in consecutive functions forming loop. License: Copy Left Enhanced the code, found a bug? Just let me know. Suha cg.lsp

Updated Version for the night, South_Elevation Model 5.pdf everything done except for dimensioning & the roofing from what I can tell (plotted in monochrome for easier viewing). For anyone that needs a better look at what is called for, assuming its all "PF correct". If anyone notices something off let me know!