Leaderboard

Yeah why not, look at date 1992, hopefully works removed some layer setting etc. 34 years ago. Dont think VL existed. Uses Lines etc. ;;;---------------------------------------------------------------------------; ;;; ;;; autodim3.LSP Version 1.0 ;; ;;; by Alan ;;; 1 April 1992 ;;; ;;; DESCRIPTION ;;; AUTOMATICALLY DIMENSIONS ; ;;;---------------------------------------------------------------------------; ; dimmensioning doesnt work if elev wrong ;(command "elev" hts "0") (SETVAR "ELEVATION" 0) (SETVAR "THICKNESS" 0) (defun mmserr (s) (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (setq S nil) (setvar "CMDECHO" cm) (setq *error* olderr) (princ) ) ;;;---------------------------------------------------------------------------; ;;; Main Program. ;;;---------------------------------------------------------------------------; (setq cm (getvar "cmdecho")) (setvar "cmdecho" 1) (setvar "dimdli" 0) (setq exlay (getvar "clayer")) (setq thick (getvar "thickness")) (setq elev (getvar "elevation")) (setq or_pt (list 0.0 0.0 0.0)) (command "osnap" "near") (setvar "thickness" 0) ;(command "elev" hts "0") ; set up dimension locations (setq ppt1 (ENTSEL "\npick first point to dimension :")) (setq tpp1 (entget (car ppt1) ) ) (setq pt1 (cdr (assoc 10 tpp1) ) ) (setq pt2 (cdr (assoc 11 tpp1) ) ) (setq hts (caddr pt1 )) (setvar "elevation" hts) (setq ang1 (angle pt1 pt2)) (setq npt1 (cadr ppt1)) (setq rad (distance pt1 npt1)) (setq ang2 (angle pt1 npt1)) (setq diffang (- ang1 ang2)) (setq dist (* (cos diffang) rad)) (setq apt1 (polar pt1 ang1 dist)) (setq pt5 (getpoint apt1 "\npick second point to dimension :")) ;(setq ss (ssget "c" apt1 pt5)) (setq ss (ssget "F" (list apt1 pt5))) (setvar "osmode" 0) (setq ang3 (angle pt5 apt1)) (setq dist (distance pt5 apt1)) (setq pt3 (getpoint pt5 "\npoint for dimension lines :")) (setq pt4 (getpoint pt5 "\nend point for dimension lines :")) (setq xyang (angle pt5 apt1)) (setq xy (distance apt1 pt5)) (setq pt6 (polar pt4 xyang xy)) (setq pt8 (inters pt1 pt2 pt4 pt6 nil)) (setq yoff (- (cadr pt8)(cadr apt1))) (setq xoff (- (car pt8)(car apt1))) (setq sss nil) (setq tempss nil) (setq dimpt1 nil) (setq dimpt2 nil) (while (setq en (ssname ss 0)) (setq dimpt1 (cdr (assoc 10 (entget en)))) (setq dimpt2 (cdr (assoc 11 (entget en)))) (setq newpt2 (inters pt5 apt1 dimpt1 dimpt2 nil)) (if (/= newpt2 nil) (progn (IF (/= NEWPT2 OLDPT) (progn (setq sss (cons newpt2 sss)) (SETQ OLDPT NEWPT2) ) ) ; CHECK TO SEE IF SAME AS PREV ) ) ; Delete each measured entity from set (ssdel en ss) ) (setq dimno (length sss)) ; loop starts at 0 (setq I 0) (setq maxx (- dimno 1)) ; start loop at dimno -2 (while (/= I maxx) ;(princ I) (setq J 1) (setq K (- dimno I) ) ; loop from 1 to dimno - I (while (/= J K) (setq j3 (LIST 1 1 1)) (setq j4 (LIST 2 2 2)) (setq j2 (nth J sss)) (setq L (- j 1)) (setq j1 (nth L sss)) ; (if (<= (CAR j2) (CAR j1)) (if (<= (distance or_pt j2) (distance or_pt j1)) (progn ; (princ "sorting ") (setq temp j2) (setq temp2 j1) (setq sss (subst j3 j2 sss)) (setq sss (subst j4 j1 sss)) (setq sss (subst J2 j4 sss)) (setq sss (subst J1 j3 sss)) ) ) (setq j (1+ j)) ) (setq i (+ I 1)) ) (PRINC "\nNow Dimensioning ") ;now plot dimmesions ; now dimension draw first to then loop for rest (setq d1 (nth 0 sss)) (setq d4 (list (+ (car d1) xoff)(+ (cadr d1) yoff))) (setq d2 (nth 1 sss)) (setq d5 (list (+ (car d2) xoff)(+ (cadr d2) yoff))) (PRINC "1") (command "DIM" "aligned" d4 d5 pt3 "") (setq x 2) (while (/= x dimno) (setq d3 (nth x sss)) (setq d6 (list (+ (car d3) xoff)(+ (cadr d3) yoff))) (PRINC "2") ; (command "diM" "continue" d6 "") (command "continue" d6 "") (setq x (+ x 1)) ) (PRINC "3") (command "exit") (setvar "CMDECHO" cm) (setvar "clayer" exlay) (setvar "elevation" elev) (setvar "thickness" thick) (setq ss nil) (princ)

This is sad news and a little concerning that no explanation is being given. On the face of it, it looks like a complete disregard for the community - I hope that's not true. What is true is that community engagement on forums like this has declined in recent years. Some of that decline is a result of AI. I know that this site has been scraped by LLM bots and, as a result, people seeking answers don't need to visit the site if an AI agent can provide the answer. Just to let you know, I have no intention of closing or suspending this forum any time soon.

@Nikon The "COND" statement will stop as soon as it meets the criteria for the square area range, so if something else meets the that area range before getting to your desired state, it will never get there. You will have to do a different comparison that is unique to the criteria. Maybe to change the criteria for the conditional statement to comparing the Length and width specifically, rather than with the area, or a combination of the area and the width, or something else, like a unique layer or color. Maybe something like this instead (you can alter to suit the fudge factor for the viewport height and width): (cond ((and (> 290.0 ViewPortHeight 300.0) (> 600.0 ViewPortWidth 650.0));; Compare the width and height directly! (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 630.00мм)") ) ((and (> 290.0 ViewPortHeight 300.0) (> 835.0 ViewPortWidth 845.0)) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 841.0мм)") ) ... ;; Repeat for all desired sizes ) NOTE: You would also have to do both a landscape version and a Portrait version if you need both. Perhaps a bit more sophisticated comparison: (cond ((or (and (> 290.0 ViewPortHeight 300.0) (> 600.0 ViewPortWidth 650.0)) (and (> 290.0 ViewPortWidth 300.0) (> 600.0 ViewPortHeight 650.0)) ) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 630.00мм)") ) ((or (and (> 290.0 ViewPortHeight 300.0) (> 835.0 ViewPortWidth 845.0)) (and (> 290.0 ViewPortWidth 300.0) (> 835.0 ViewPortHeight 845.0)) ) (vla-put-ConfigName Layout "DWG To PDF.pc3") (vla-put-CanonicalMediaName Layout "UserDefinedMetric (297.00 x 841.0мм)") ) ... ; Repeat for all desired sizes (T (vla-put-ConfigName Layout "None")) ; Default to No plotter for non-standard sizes ) NOTE: I can't test this directly without a "real world" sample drawing to compare, along with your pc3 file, so I'm trying to give you the knowledge to do it yourself, which is preferrable anyway.

You must've copied the changes into your code incorrectly. "RH: DXF" is already defined in your original code. (defun rh:dxf (code lst) (cdr (assoc code lst))) Attached is your original code with @mhupp's change: (defun rh:dxf (code lst) (cdr (assoc code lst))) (defun c:aa ( / cmde ent e_typ e_lst area vtx x_lst y_lst z_lst x_pt y_pt z_pt c_lst v_lst ss sum) (cond ( (/= 0 (getvar 'cmdecho)) (setq cmde (getvar 'cmdecho)) (setvar 'cmdecho 0) ) ) (while (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE,LWPOLYLINE") (-4 . "<OR") (70 . 1) (70 . 3) (70 . 5) (-4 . "OR>") ) )) (setq ent (ssname ss 0) e_typ (rh:dxf 0 (setq e_lst (entget ent))) area (getpropertyvalue ent "area") v_lst nil ) (cond ( (= e_typ "POLYLINE") (setq ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) (while (/= "SEQEND" (cdr (assoc 0 (entget ent)))) (setq v_lst (cons vtx v_lst) ent (entnext ent) vtx (rh:dxf 10 (entget ent)) ) (if (< (length vtx) 3) (setq vtx (reverse (cons 0.0 (reverse vtx))))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) (if (= (setq sum (apply '+ (mapcar '(lambda (x) (caddr x)) v_lst))) 0.0) (setq z_pt 0.0) (setq z_pt (/ sum (length v_lst))) ) ) ( (= e_typ "LWPOLYLINE") (setq z_pt (rh:dxf 38 e_lst)) (foreach pr e_lst (if (= (car pr) 10) (setq v_lst (cons (cdr pr) v_lst))) ) (setq x_pt (/ (apply '+ (mapcar '(lambda (x) (car x)) v_lst)) (length v_lst)) y_pt (/ (apply '+ (mapcar '(lambda (x) (cadr x)) v_lst)) (length v_lst)) ) ) ) (setq c_lst (list x_pt y_pt z_pt)) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 c_lst) (cons 40 (getvar 'textsize)) (cons 71 5) (cons 72 5) (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m" (chr 0178))) ; (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m²")) ; (cons 1 (rtos (/ area 1000000.0) 2 3)) ; If you don't need the suffix "m²" ) ) ) (if cmde (setvar 'cmdecho cmde)) )

chr instead of string. (cons 1 (strcat (rtos (/ area 1000000.0) 2 2) "m" (chr 0178))) also might be the font your using. https://www.cadtutor.net/forum/topic/75383-text-ascii/#findComment-596226

@pmadhwal7 Looks like you had this same problem in 2019. MLEADERS were suggested to you then and you didn't try the tools offered? I did the following with a LEADER to MLEADER conversion very quickly:

100% setenv is writing strings to your windows registry. not good if you are doing that for all variables. might want to check to see what else you have been writing there. HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R##.#\ACAD-####:###\Profiles\<<Unnamed Profile>>\Variables tho setenv will persist even after reboot. overkill for most variables need in lisp. like @pkenewell said you should be good with just global variables. that holds while the drawing is open but make them unique. if you need to hold a variable in the drawing itself. use ldata that will persist in the drawing. so you can close and reopen it.

Or using the method proposed by @Stefan BMR we could automate in lisp like this: (enter the distances when the cursor is on the tracking line to get the desired angles) (defun des_vec (lst col / lst_sg) (setq lst_sg (list (cadr lst) (car lst))) (setq lst (cdr lst)) (while lst (if (cadr lst) (setq lst_sg (cons (cadr lst) (cons (car lst) lst_sg))) ) (setq lst (cdr lst)) ) (setq lst_sg (cons col lst_sg)) (grvecs lst_sg) ) (defun c:pl90-45 ( / old_set p1 p2 lst_pt msg) (setq old_set (mapcar 'getvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE"))) (initget 33) (setq p1 (getpoint "\nPick start point: ")) (initget 33) (setq p2 (getpoint p1 "\nReference start angle: ") lst_pt (list (list (car p1) (cadr p1))) msg "\nGive distanve in the direction of cursor: " ) (mapcar 'setvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE") (list 0 0 (angle p1 p2) (* 0.25 pi) 3 2 (angle p1 p2) 1) ) (initget 303) (while (and (setq p2 (getpoint p1 msg)) (/= p2 "C")) (cond ((/= p2 "U") (setq p2 (list (car p2) (cadr p2))) (mapcar 'setvar '("AUTOSNAP" "SNAPANG" "ORTHOMODE") (list 10 (angle p1 p2) 0) ) (setq p1 p2 lst_pt (cons p2 lst_pt) msg "\nGive distanve in the direction of cursor or [C/U] for Close or Undo : " ) ) (T (setq lst_pt (cdr lst_pt) p1 (car lst_pt) ) ) ) (redraw) (des_vec lst_pt 7) (initget 302 "C U") ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (getvar "CLAYER")) '(100 . "AcDbPolyline") (cons 90 (length lst_pt)) (if (= p2 "C") '(70 . 1) '(70 . 0)) ) (mapcar '(lambda (x) (cons 10 x)) lst_pt) ) ) (mapcar 'setvar '("GRIDMODE" "ANGDIR" "ANGBASE" "POLARANG" "POLARMODE" "AUTOSNAP" "SNAPANG" "ORTHOMODE") old_set) (prin1) )

fixed an error with substr to only remove the first char of the string. and added your + option.

@mhupp great code no reason why input could not be 7.7;-12;22.8;12;-5.9;21.6;-0.5;\3.5;8;2.5;\1.5;13.8 in this case each leg is separated by a semi colon, or more often a comma is used. Could type in say notepad and copy and paste to a getstring. The reason for the paste rather than type direct would be if made a mistake you UNDO fix in notepad and do again. Use "parse to list" defun. @Ataim what do you think about that idea ?

If I understand correctly your request, I think you can get the same with the right settings. Just aim the desired direction and specify the distance.

Your points will fall on the grid lines not inside the boxes created by the grid lines.

In other words, you are having trouble understanding the concept of interpolation, correct? The mathematical interpolation of contours goes like this. Let's say we have two spot elevations A & B. A = 32.7 and B = 54.0. The distance between A & B = 50 feet. We want to know where our 40-foot contour would fall between spot elevations A & B. First obtain the total elevation difference. This is done by subtracting A from B. 54.0 minus 32.7 = 21.3. Next, we want the difference in elevation between our 40-contour interval and the nearest spot elevation which in this case is A or 32.7. That works out to be 7.3. Now we need to calculate the distance (let's call this "d") we need to go from spot elevation A to our 40-foot contour. That takes the form of: d/7.3=50/21.3 or d=7.3*50/21.3 = 7.3*2.347 = 17.13 or the distance, in decimal feet, to our 40-foot contour. Got all that? Good. Now go start interpolating.

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

If I understood the request correctly... This could be a design start, it uses the oblique block of the dimension. (vl-load-com) (defun circle2lw (e / dxf_ent pt_cen radius fst_pt opp_pt) (setq dxf_ent (entget e) pt_cen (cdr (assoc 10 dxf_ent)) radius (cdr (assoc 40 dxf_ent)) fst_pt (polar pt_cen 0.0 radius) opp_pt (polar pt_cen pi radius) ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent) (if (assoc 6 dxf_ent) (assoc 6 dxf_ent) '(6 . "BYLAYER")) (if (assoc 62 dxf_ent) (assoc 62 dxf_ent) '(62 . 256)) (if (assoc 370 dxf_ent) (assoc 370 dxf_ent) '(370 . -3)) (if (assoc 48 dxf_ent) (assoc 48 dxf_ent) '(48 . 1.0)) '(100 . "AcDbPolyline") '(90 . 2) '(70 . 1) (cons 43 0.0) (cons 38 (caddr fst_pt)) (if (assoc 39 dxf_ent) (assoc 39 dxf_ent) '(39 . 0.0)) (cons 10 (list (car fst_pt) (cadr fst_pt))) '(40 . 0.0) '(41 . 0.0) '(42 . 1.0) (cons 10 (list (car opp_pt) (cadr opp_pt))) '(40 . 0.0) '(41 . 0.0) '(42 . 1.0) (assoc 210 dxf_ent) ) ) (entdel e) (entlast) ) (defun c:Mybreak ( / ent obj_brk pt_brk vlaobj pr deriv alpha) (setvar "DIMBLK" "oblique") (while (setq ent (entsel "\nBreak point: ")) (setq obj_brk (car ent)) (cond ((member (cdr (assoc 0 (entget obj_brk))) '("POLYLINE" "LWPOLYLINE" "LINE" "ARC" "CIRCLE" "ELLIPSE" "SPLINE" "XLINE" "RAY")) (setq pt_brk (cadr ent)) (if (eq (cdr (assoc 0 (entget obj_brk))) "CIRCLE") (setq obj_brk (circle2lw obj_brk))) (setq vlaobj (vlax-ename->vla-object obj_brk)) (initget 1) (setq pt_brk (vlax-curve-getClosestPointTo vlaobj (trans pt_brk 1 0) nil ) pr (vlax-curve-GetParamAtPoint vlaobj pt_brk) deriv (vlax-curve-getFirstDeriv vlaobj pr) alpha (atan (cadr deriv) (car deriv)) ) (command "_.break" obj_brk "_none" pt_brk "_none" pt_brk) (initget 1) (command "_.-insert" "_oblique" "_scale" (distance (trans pt_brk 0 1) (getpoint (trans pt_brk 0 1))) (trans pt_brk 0 1) (angtos alpha (getvar "AUNITS") 13)) ) (T (princ "\nThis object can't be break!")) ) ) (princ) )

You might try Lee Mac's Steal from Drawing | AutoCAD | Autodesk App Store. I just do a SAVE or SAVEAS on the drawing and make a new exact COPY of the drawing. If I have similar drawing that could use the other viewport and settings, I just drag the Layout from one drawing to the other with Design Center. There is an Export Layout to Model... when you right-click a Layout TAB and before that option was in AutoCAD there were some programs that would do that. To do what you want looks to be a lot of work for a LISP.

Command CBL: puts the Breakline symbol 4.0 units from the start, the breakline symbol is 1.0 units wide, and the tip is 0.4 units up or down the line. Obviously feel free to change those values. command CBLU: Same, except the user must give all the values. ;; Custom Breakline ;; @params ;; ps: start point ;; pe: end point ;; gap: gap between the two halves of the lines ;; loc: location of the center of the gap ;; tip: vertical size of the tip of the breakline symbol (default there's is 70° angle, but we'll give tip size) (defun CustomBreakLine ( ps pe gap loc tip / angl dst pline pl pd pm pu pr ) (setq angl (angle ps pe)) ;; angle (setq dst (distance ps pe)) ;; distalce of the line (without the breakline symbol) (setq pm (polar ps angl loc)) ;; mid point of the gap (setq pl (polar ps angl (- loc (/ gap 2.0)))) ;; left point of the breakline symbol (setq pr (polar ps angl (+ loc (/ gap 2.0)))) ;; right point of the breakline symbol ;; down tip of the breakline symbol (setq pd1 (polar pl angl (/ gap 4.0))) (setq pd (polar pd1 (- angl (d2r 90.0) ) tip)) ;; up tip of the breakline symbol (setq pu1 (polar pm angl (/ gap 4.0))) (setq pu (polar pu1 (+ angl (d2r 90.0) ) tip)) (setq pl (drawLWPoly (list ps pl pd pu pr pe) 0)) ) ;; degree to rad (defun d2r (d / ) (/ (* pi d) 180.0) ) ;; Returns the middle of two points (defun mid-pt (p1 p2) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) ) ) ;; makes a polyline object with entmakex (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;; ;; Custom BreakLine, User input values (defun c:cblu ( / ps pe gap loc tip ) (CustomBreakLine (setq ps (getpoint "\nStart pont: ")) (setq pe (getpoint ps "\nEnd pont: ")) (setq gap (getdist "\nGap distance: ")) (setq loc (getdist "\nLocation of the gap center (enter value, or select two points: start point + point of the gap): ")) (setq tip (getdist "\nTip height: ")) ) (princ) ) ;; Custom BreakLine, preset values (defun c:cbl ( / ps pe gap loc tip ) (CustomBreakLine (setq ps (getpoint "\nStart pont: ")) (setq pe (getpoint ps "\nEnd pont: ")) (setq gap 1.0) (setq loc 4.0) (setq tip 0.4) ) (princ) ) (princ "\nCommand CBL for Custom BreakLine: ") (princ) Happy with this?

You created this thread before even trying it in your AutoCAD?

Did you google found lots of ideas.

In this link, it's written that OOPS command exist : In AutoCAD since version ≤ R12...

Bit odd yes tested in Bricscad, I will look at the getcellextents, this gives the XY position of the corners of the table cell. If the line is 69 times repeated it sounds like that is the problem. I will make a little test program so can look at what is going on when calculating the Pt1 and Pt2. the code is done that way so if row height is changed for other users the lines are still central in the cell. Add the (princ line and look at the Y value displayed, it should change for every row. Please let me know if it is not changing. (setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0)) (princ (strcat "\n" (rtos (cadr pt1) 2 3) " ")) (setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0)) Another test could some one try on Acad. 0 is 1st column. (setq objtable (vlax-ename->vla-object (car (entsel "\nPick a table ")))) ; put a number like 3+ in row variable ; then copy this line to command line change the 3 etc to 4 5 6 and so on ; The Y value should change (setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable 3 0 :vlax-false))))

Works with BricsCAD. I know you have to wrap points in AutoCAD sometimes with (vlax-3d-point pt2) not sure about entmake tho.

Almost there its a table fixed a couple of bugs and done. Tested on a dwg with 500 layers a little slow takes a few seconds. ; https://www.cadtutor.net/forum/topic/99017-layer-table-lines-and-text/ ; Make a lgend of layers in dwg. ; Bt AlanH March 2026 (defun c:mktablay ( / colwidth doc lay lcol ldesc lname lst numrows objtable oldsnap pt pt1 pt2 rowheight) (defun CreateTableStyle ( / dicts dictobj key class custobj dwglays ) (setq dicts (vla-get-Dictionaries (vla-get-ActiveDocument(vlax-get-acad-object)))) (setq dictObj (vla-Item dicts "acad_tablestyle")) (vlax-for dname dictobj (if (= (vla-get-name dname) "DWGLAYERS" ) ; does it exist (princ "Found DWGLAYERS") (setq dwglays "No") ) ) (if (= dwglays "No") (progn (setq key "DWGLAYERS" class "AcDbTableStyle") (setq custObj (vla-AddObject dictObj key class)) (vla-put-Name custObj "DWGLAYERS") (vla-put-Description custObj "Dwg Index custom table style") (vla-put-BitFlags custObj 1) (vla-put-FlowDirection custObj acTableTopToBottom) (vla-put-HorzCellMargin custObj txtht ) (vla-put-VertCellMargin custObj txtht ) (vla-SetAlignment custObj (+ acDataRow acHeaderRow acTitleRow) acMiddleCenter) (vla-SetTextHeight custObj acDataRow txtht) (vla-SetTextHeight custObj acHeaderRow (* txtht 1.2)) (vla-SetTextHeight custObj acTitleRow (* txtht 1.5)) (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "Standard") ) ) (princ) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq txtht 1.5) (CreateTableStyle) (setvar 'ctablestyle "DWGLAYERS") (setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))) (setq lst '()) (vlax-for lay lays (setq lname (vlax-get lay 'name)) (setq lcol (vlax-get lay 'color)) (setq ldesc (vlax-get lay 'description)) (setq lst (cons (list lcol lname ldesc) lst)) ) (setq lst (vl-sort lst '(lambda (x y) (< (cadr x)(cadr y))))) (setq pt (vlax-3d-point (getpoint "\npick a point for table "))) (setq doc (vla-get-activedocument (vlax-get-acad-object) )) (if (= (vla-get-activespace doc) 0) (setq curspc (vla-get-paperspace doc)) (setq curspc (vla-get-modelspace doc)) ) (setq numrows 3) (setq numcolumns 3) (setq rowht 5) (setq colwidth 50) (setq objtable (vla-addtable curspc pt numrows numcolumns rowht colwidth)) (vla-settext objtable 0 0 "Layer Details") (vla-settext objtable 1 0 "Color Numb. & Linetype") (vla-settext objtable 1 1 "Layer Name") (vla-settext objtable 1 2 "Layer description") (setq objtable (vlax-ename->vla-object (entlast))) (setq rowht (vla-getrowheight objtable 1)) (vla-put-regeneratetablesuppressed objtable :vlax-true) (setq row 2) (foreach lay lst (princ (cadr lay)) (vla-settext objtable row 0 (strcat (rtos (car lay) 2 0) " ")) (vla-setcellalignment objtable row 0 acMiddleRight) (vla-settext objtable row 1 (cadr lay)) (if (= (caddr lay) "") (setq desc (cadr lay)) (setq desc (caddr lay)) ) (vla-settext objtable row 2 desc) (setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable row 0 :vlax-false)))) (setq pt1 (list (nth 0 pts)(nth 1 pts) 0.0)) (setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0)) (setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0)) (setq pt1 (mapcar '+ pt1 (list 5.0 (- vdist) 0.0))) (setq pt2 (list (nth 3 pts)(nth 4 pts) 0.0)) (setq pt2 (mapcar '+ pt2 (list (- 7.0) (- vdist) 0.0))) (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2) (cons 8 (cadr lay)))) (vla-insertrows objtable (setq row (1+ row)) rowht 1) ) (vla-put-regeneratetablesuppressed objtable :vlax-false) (setvar 'osmode oldsnap) (princ) ) (c:mktablay)

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.

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.

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.

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.

Not sure if this will work the way you want. I created a dummy drawing with a dummy block and a dummy attribute. When you set the attribute to Invisible, you can't see it any more, but you can edit it. I know, that's not what you want. I include it so you don't waste time trying it for yourself. When you set the attribute to Constant, you can't edit it at all. It no longer shows up in the Properties, and it doesn't show up in the block. If you change the attribute back to not constant, you can insert a new block and give it a different value, but it's still invisible and it does show up in Properties. Could be a bug? Or the way I handled it.

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

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.