Leaderboard

@JTM It is possible to do what you want using global variables. Care must be taken with global variable so you don't create name conflicts. The following code creates global variables *qty3BY6* and *len3BY6* which are probably unique enough to avoid conflict in your system. I added a subroutine to input values with a default. The subroutine comes from the book "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012. I believe there is a newer version. It is a good book for lisp. The following code uses global variables. ;Routine to create special fillet between two intersecting lines. ;https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/#google_vignette ;Modified: Jerry Fiedler - Apr 2025 ; Determine angle by USER selecting two lines instead of numerical input. ; Added USER options to show arc and extend lines to apex. ;Revised: Jerry Fiedler - Apr 2025 ; Replaced Geometric Calculator function with custom routine CALang3P. ; Made line extensions a polyline. ; Added ability of user to input number of chords and their length. ;Revised: Jerry Fiedler - May 2025 ; Changed quantity and length input to global variables *qty3BY6* and *len3BY6*. ; Added subroutine for input with default values. ;Reference code: ; paulmcz - Equations for arc radius calculation. ; BigAl - Code for creating the arc and chamfers. ; LeeMac - Entmake code. ; Reinaldo Togores - Prompt for input with default values subroutine. ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (defun c:3BY6 ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux x end1 end2 arc len ans arcnm pS pE nodes j nm) ; Recall stored variables. ; If global variables are undefined set to zero. First time command called. (or *qty3BY6* (setq *qty3BY6* 0)) (or *len3BY6* (setq *len3BY6* 0.0)) ; Accept stored values or enter new values. (initget 6 ) ; No negative values or zero. (setq *qty3BY6* (default-value 'getint "\nEnter quantity of chords: " *qty3BY6*)) (initget 6 ) ; No negative values or zero. (setq *len3BY6* (default-value 'getreal "\nEnter chord length: " *len3BY6*)) ; Select lines. (setq ent1 (car (entsel "\nPick Line 1 "))) (setq ent2 (car (entsel "\nPick Line 2 "))) ; Get end points of selected lines. (setq obj1 (vlax-ename->vla-object ent1)) (setq obj2 (vlax-ename->vla-object ent2)) (setq p1 (vlax-get obj1 'startpoint)) (setq p2 (vlax-get obj1 'endpoint)) (setq p3 (vlax-get obj2 'startpoint)) (setq p4 (vlax-get obj2 'endpoint)) ; Calculate the intersection point Line 1 and Line 2. (setq apex (inters p1 p2 p3 p4 nil)) ; Calculate angle X. (if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1)) (if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3)) (setq x (CALang3P apex end1 end2)) (if (> x 180) (setq x (- 360 x))) (setq x (* pi (/ x 180.0))) ; Calculate the arc radius. (setq u1 (- pi x)) (setq ux (/ u1 (* 2 *qty3BY6*))) (setq rad(/ (/ *len3BY6* 2) (sin ux))) ; Create arc. (setvar 'filletrad rad) (command "fillet" ent1 ent2) (setq arcnm (entlast)) ; (command "chprop" arcnm "" "_LA" "P" "") (setq arc (vlax-ename->vla-object arcnm)) ; Establish nodes for chamfers. (setq len (/ (vlax-get arc 'arclength) *qty3BY6*)) (setq pS (vlax-get arc 'startpoint)) (setq pE (vlax-get arc 'endpoint)) (setq j 0) (repeat (1+ *qty3BY6*) (setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes)) (setq j (1+ j)) ) ; Create chord pline from list of nodes. ; Entmake code by Lee Mac (McDonnell) Febrary 2010 ; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347 (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length nodes))) (mapcar (function (lambda (p) (cons 10 p))) nodes)) ) ; Delete arc? (initget "YES NO") (setq ans "NO") (setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES"))) (if (= ans "NO") (entdel arcnm)) ; Extend lines to apex? (initget "YES NO") (setq ans "NO") (setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES"))) (if (= ans "YES") (progn (command "pline" pS apex pE "") ; (command "chprop" (entlast) "" "_LA" "P" "") ) ) (princ) ) ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Prompt for input with default values. ; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012 ; Listing 7.1 in source book. ; Arguments: ; func -> An AutoCAD get... function preceded with a ' (NOT for getstring) ; message -> Prompt requesting input. ; value -> Defalut value which is used if <Enter> is pressed at prompt. (defun default-value (func message value / tmp) (if (setq tmp (apply func (list (strcat message "<" (vl-princ-to-string value) ">: " ) ) ) ) tmp value ) ) (princ) THREE_SIX_Rev2.LSP

I didn't check the original at the link. Maybe, seems to work for me. ;;;;;;;;;;;;;;;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-script-to-generate-list-of-all-layouts-table-of-contents-as/td-p/13203001;;;;;;;;;;;;;;;;;;;;; (defun c:ExportLayoutsToCSV (/ doc doc-path doc-name toc-folder csv-file-name layout-list csv-file-path file-handle ss blkname att frmatt frmtag frmval frametxtobj layout lyt) (if (not (vl-load-com)) (vl-load-com)) ; Load COM support if not already loaded ;; Get the full path of the active document (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))) (setq doc-path (vlax-get-property doc 'Path)) (setq doc-name (vlax-get-property doc 'Name)) ;; Ensure the document path exists (if doc-path (progn ;; Construct the "table of contents" folder path (setq toc-folder (strcat doc-path "\\table of contents")) ;; Check if folder exists, if not create it (if (not (vl-file-directory-p toc-folder)) (vl-mkdir toc-folder) ) ;; Construct the CSV file path (setq csv-file-name (strcat "Table of Contents - " (vl-filename-base doc-name) ".csv")) (setq csv-file-path (strcat toc-folder "\\" csv-file-name)) ;; Get the list of layout names (setq layout-list (layoutlist)) ;; Open file for writing (setq file-handle (open csv-file-path "w")) (if file-handle (progn (write-line "layout,name" file-handle) ;; Write the layout names to the file ;; Redid this part ------------------------------------------------------------ (foreach layout layout-list (setq frametxtobj "-") ; default if nothing found (if (and layout (setq ss (ssget "X" (list '(0 . "INSERT") '(2 . "framenumber") (cons 410 layout))))) (progn (setq blkname (ssname ss 0)) (setq frmatt (vlax-invoke (vlax-ename->vla-object blkname) 'getattributes)) (foreach att frmatt (setq frmtag (vla-get-tagstring att)) (setq frmval (vla-get-textstring att)) (if (= frmtag "FRAMENUM") (setq frametxtobj frmval) ) ) ) ) (setq writeln (strcat layout "," frametxtobj)) (write-line writeln file-handle) ) ;;------------------------------------------------------------------------- (princ (strcat "\nLayout names exported to: " csv-file-path)) (close file-handle) ) (princ "\nError: Unable to open file for writing.") ) ) (princ "\nError: Unable to determine the document path.") ) (princ) ; Suppress return value in the command line ) What you had... (foreach layout (layoutlist) (if(setq ss (ssget "X" '((0 . "INSERT") (2 . "framenumber") (410 . layout)))) (progn (setq blkname (ssname ss 0)) (setq frmatt (vlax-invoke (vlax-ename->vla-object blkname) 'getattributes)) (foreach att frmatt (setq frmtag (vla-get-tagstring att)) (princ frmtag) (setq frmval (vla-get-textstring att)) (if (= frmtag "FRAMENUM") (progn (setq frametxtobj frmval) (setq lyt layout) ) (setq frametxtobj "-") );if );foreach );progn );if ;(princ frametxtobj) (setq writeln (strcat layout "," frametxtobj)) (write-line writeln file-handle) )

@Steven P You can change the name of a "Uxx" by looking for it in the block table, a "Uxx" block does not appear if checking via the Insert command. This is what I was using for top level block name change. (if (wcmatch bname "**U##*" ) (progn (setq ins (cdr (assoc 10 (entget ent)))) (command "zoom" "c" ins 40) ; zooms to block so can see what it looks like (setq bnamenew (getstring (strcat "\n\n existing name " bname " Enter new name "))) (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (if (= (vlax-get block 'name) bname) (vlax-put block 'name bnamenew) ) ) ) ) I think I have to start all over again. Given the time involved so far could probably have redone each block manually by now.

Just a comment, there is no need to do the select columns twice, just select all, you can sort on Y then X the list of values. it will then produce a list of 2 values repeated. ; sorts on 1st two items (setq lst (vl-sort lst '(lambda (a b) (cond ((< (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))) ) ) ) )

Trusted locations are OK, I think you can get them easy enough. I tend to save mine away on the shared drive - upgrade CAD, machine breaks, or whatever and I don't loose them - and I don't think you can get that location from the LISP that is running, you need some sort of hard coding in there. Hard coding might be constructed within the code (example (strcat "c:\Users" UserName "\CAD\LISPs\") ) but still coded in there

Maybe somewhere in registry can be holded data about that (for e.g. HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\<Rxx.x>\ACAD-xxxx:xxx\Profiles\<CurrentProfile>\Dialogs\Appload)

Thanks for those links. I'll take a look with great curiosity. This may seem crazy, but my intention was to write something to decompress the ODS from Visual Lisp directly, without calling (startapp "7z.exe") and interact directly with the XML. It's a self-contained, brute-force project, but I ran into an even bigger hurdle: LibreOffice ODS are compressed with 'deflate'. For this reason, I've shelved this project. As for your code, if you attach a test drawing with some of the blocks you've written the code for, I'll run tests for it as well.

By the way: I'm still using AutoCAD 2002. If I have to run code to process thousands of objects, the processing speed is 4/5 times faster.

I considered doing something to work directly with the OBS file, but this is like "shooting flies with a cannon." So I think your option is better: work with a CSV as a bridge file. PS: I don't think 'vl-string-split' will work in ACAD 2000.