Leaderboard

oh darn , I allways forget that one... post above updated... (defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x)))))

once made (and posted) this one for fun. Use function (c:t2) : select folder , app searches *.* and displays them in listbox. With out clicking on anything start typing letters and numbers that should be part of filename. The more you type , the smaller the list becomes. When list is small enough press ok and all files in listbox will be openend. So make sure your list box doesn't still contain 100 drawings because it will try to open every single one of them and app is very hard to kill (use ctr-alt-del) ;;; DIP - Dynamic Input , Rlx Sep'23 ;;; sort of (grread) for dcl with exception for space, tab & enter which are reserved by dcl ;;; haven't (yet) found a way to catch character for space. ;;; So gonna use ' (quote) for space, not ideal but it is what it is (vl-load-com) (defun dip ( %lst / dip-list dip-width key-lst imb-str capslock bksp bksl qmrk eb-txt f p d r ib dialog-list drv lb-sel return-list) (setq dip-list %lst) ;;; make sure all elements are strings (setq dip-list (mapcar 'vl-princ-to-string dip-list)) ;;; find length of longest member (setq dip-width (car (vl-sort (mapcar 'strlen dip-list) '>))) ;;; create key codes (setq key-lst (vl-remove-if '(lambda (x)(member x '(34 92))) (append (gnum 33 95) (gnum 123 125)))) (setq imb-str ":image_button {color=dialog_background;width=0.1;height=0.1;fixed_height=true;key=\"ib_") ;;; see if acet-sys-keystate function is available (setq capslock (member 'acet-sys-keystate (atoms-family 0)) eb-txt "" bksp (strcat ":image_button {color=dialog_background;width=0.1;height=0.1;" "fixed_height=true;key=\"ib_bksp\";label=\"&\010\";}") bksl (strcat ":image_button {mnemonic=\"\\\\\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_bksl\";label=\"&\\\\\";}") qmrk (strcat ":image_button {mnemonic=\"\\\"\";color=dialog_background;width=0.1;" "height=0.1;fixed_height=true;key=\"ib_qmrk\";label=\"&\\\"\";}") ) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (mapcar '(lambda (x) (write-line x p)) (append (list "dip:dialog {label=\"DIP - Dynamic Input (Rlx Sep'23)\";:row {alignment=centered;") (crim) (list bksp bksl qmrk "}") (list ":image_button {color=141;height=1;fixed_height=true;key=\"ib_ib\";}" ":text_part {key=\"tp\";height=1;width=40;}" ) (list (strcat ":list_box {height=25;width=" (itoa (fix (* dip-width 0.9))) ";key=\"lb\";multiple_select=true;}") "ok_cancel;" "}") ) ) (not (setq p (close p))) (< 0 (setq d (load_dialog f))) (new_dialog "dip" d) (progn (upd_lbox) (action_tile "ib_bksp" "(upd_txtp $key)") (action_tile "ib_bksl" "(upd_txtp $key)") (action_tile "ib_qmrk" "(upd_txtp $key)") (stim) (action_tile "lb" "(setq lb-sel $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq drv (start_dialog)) (unload_dialog d) (vl-file-delete f) ) ) (cond ((= drv 0)) ((= drv 1) (cond ((and (boundp lb-sel) (vl-consp dialog-list)) (setq return-list (mapcar '(lambda (x)(nth (atoi x) dialog-list)) (SplitStr lb-sel "")))) ((vl-consp dialog-list) (setq return-list dialog-list)) (t (setq return-list nil)) ) ) (t (setq return-list nil)) ) return-list ) ;;; create image_buttons : (setq lst (gimb)) (defun crim () (mapcar '(lambda (x)(strcat imb-str (chr x) "\";label=\"&" (chr x) "\";}")) key-lst)) ;;; start image_buttons (defun stim () (foreach x key-lst (action_tile (strcat "ib_" (chr x)) "(upd_txtp $key)"))) ;;; update edit_box , k = key (ib_$) (defun upd_txtp ( k / s l) (cond ;;; backspace ((and (eq k "ib_bksp") (> (setq l (strlen eb-txt)) 1)) (setq eb-txt (substr eb-txt 1 (1- l)))) ;;; backslash ((eq k "ib_bksl") (setq eb-txt (strcat eb-txt "\\"))) ;;; quotation mark ((eq k "ib_qmrk") (setq eb-txt (strcat eb-txt "\""))) ;;; use ' for space ((eq k "ib_'") (setq eb-txt (strcat eb-txt " "))) (t (setq eb-txt (strcat eb-txt (case (substr k 4))))) ) (if (wcmatch (strcase eb-txt t) "*bksp")(setq eb-txt "")) (start_image "ib_ib") (fill_image 0 0 (dimx_tile "ib_ib") (dimy_tile "ib_ib") 141) (end_image) (set_tile "ib_ib" eb-txt) (mode_tile k 2) (upd_lbox) ) (defun upd_lbox ( / filter) (if (not (vl-consp dip-list)) (setq dip-list '("void"))) (cond ((= eb-txt "") (setq dialog-list dip-list)) (t (setq filter (strcat "*" eb-txt "*")) (setq dialog-list (vl-remove-if-not '(lambda (x)(wcmatch (strcase x) (strcase filter))) dip-list)) ) ) (start_list "lb") (mapcar 'add_list dialog-list) (end_list) (set_tile "tp" (strcat " selected " (itoa (length dialog-list)) " of " (itoa (length dip-list)))) ) ;;; helper functions ;;; determine status caps lock for when typing filter (even though filter uses strcase) (defun case (s) (cond ((null s) "") ((not (eq (type s) 'STR)) "") ((null capslock) s) (t (if (= (acet-sys-keystate 20) 0) (strcase s t) (strcase s))))) ;;; generate number (gnum 1 5) -> '(1 2 3 4 5) (defun gnum (s e / i l) (and (numberp s)(numberp e)(setq i s)(while (<= i e)(setq l (cons i l) i (1+ i)))) (reverse l)) ; (SplitStr "a,b" ",") -> ("a" "b") (defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) ;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil) (defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d))) (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e))) (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1)))))) (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1)))) ; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path") (defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\"))) ; returns T if no errors occurred during program execution (defun ShellOpen ( $f / it sh ) (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it))) (progn (prompt "\nShell application was unable to open file")(setq it nil)))) (defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x))))) ;;; test function (defun c:t1 () (setq lst (dip (alf (car (fnsplitl (findfile "acad.exe"))) "*.dwg" t))) (alert (apply 'strcat (mapcar '(lambda (x)(strcat x "\n")) lst))) ) ;;; select a folder , app finds all files , don't click anything but just start typing and list will be updated with filter you typed ;;; after that all files left will be opened so don't try to open 100 autocad drawings at once... (defun c:t2 ( / fol lst dip-list) (if (and (setq fol (GetShellFolder "Select folder to search")) (vl-consp (setq lst (alf fol "*.*" t))) (vl-consp (setq dip-list (dip lst)))) (foreach f dip-list (ShellOpen f))))

(defun make_text (pt str / ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 40 (getvar "TEXTSIZE")) (cons 1 str) ) ) ) (defun c:line&offset ( / old_styl txt_size p1 p2 p3 p4 px dx dy) (setq old_styl (getvar "TEXTSTYLE")) (setvar "TEXTSTYLE" "Standard") (initget 6) (if (setq txt_size (getdist (getvar "VIEWCTR") (strcat "\nNew textsize <" (rtos (getvar "TEXTSIZE")) ">: "))) (setvar "TEXTSIZE" txt_size) ) (mapcar 'setvar '("PDMODE" "PDSIZE") (list 35 (* 0.25 (getvar "TEXTSIZE")))) (initget 9) (setq p1 (getpoint "\nFirst point: ")) (initget 9) (setq p2 (getpoint p1 "\nSecond point: ")) (entmake (list '(0 . "LINE") '(100 . "AcDbEntity") '(100 . "AcDbLine") (cons 10 p1) (cons 11 p2) ) ) (mapcar '(lambda (x) (make_text (car x) (cdr x))) (list (cons (polar p1 0.0 (getvar "TEXTSIZE")) (strcat "X: " (rtos (car p1)))) (cons (polar (polar p1 0.0 (getvar "TEXTSIZE")) (- (* 0.5 pi)) (* 1.923076923076925 (getvar "TEXTSIZE"))) (strcat "Y: " (rtos (cadr p1)))) (cons (polar p2 0.0 (getvar "TEXTSIZE")) (strcat "X: " (rtos (car p2)))) (cons (polar (polar p2 0.0 (getvar "TEXTSIZE")) (- (* 0.5 pi)) (* 1.923076923076925 (getvar "TEXTSIZE"))) (strcat "Y: " (rtos (cadr p2)))) ) ) (initget 9) (while (setq p3 (getpoint "\nPoint to calculate?:")) (setq p4 (polar p3 (+ (angle p1 p2) (* 0.5 pi)) (distance p1 p2)) px (inters p1 p2 p3 p4 nil) dx (distance p1 px) dy (distance px p3) ) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 p3) ) ) (mapcar '(lambda (x) (make_text (car x) (cdr x))) (list (cons (polar p3 0.0 (getvar "TEXTSIZE")) (strcat "Line: " (rtos dx))) (cons (polar (polar p3 0.0 (getvar "TEXTSIZE")) (- (* 0.5 pi)) (* 1.923076923076925 (getvar "TEXTSIZE"))) (strcat "OFFSET: " (rtos dy))) ) ) ) (setvar "TEXTSTYLE" old_styl) (prin1) )

Try - (defun c:prueba ( ) (princ "DISE\\U+00D1O 3040") (princ) )

Is the same that me! Sorry I don't understand why it's not work.

What does the SYSCODEPAGE variable return in commandline? For me your function work's correctly.

I think you're talking about test function c:t1 , as stated in my post above use c:t2 well, I'm off, wedding anniversary ... already donated one of my ribs to buy roses for the wife , now I have to feed her too... there goes another of my ribs , probably two

I merged your posts, stop creating new posts for the same topic.

Right-Click a Drawing Tab and select Open File Location. Also another thread on this subject. And of course...Open | Lee Mac Programming (lee-mac.com)

And just this? (defun c:foo ( / p1 p2 p3 p4 px dx dy) (initget 9) (setq p1 (getpoint "\nFirst point: ")) (initget 9) (setq p2 (getpoint p1 "\nSecond point: ")) (initget 9) (setq p3 (getpoint "\nPoint to calculate?:") p4 (polar p3 (+ (angle p1 p2) (* 0.5 pi)) (distance p1 p2)) px (inters p1 p2 p3 p4 nil) dx (distance p1 px) dy (distance px p3) ) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 10 p3) ) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 (polar p3 0.0 (getvar "TEXTSIZE"))) (cons 40 (getvar "TEXTSIZE")) (cons 1 (strcat "Line: " (rtos dx))) ) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 (polar (polar p3 0.0 (getvar "TEXTSIZE")) (- (* 0.5 pi)) (* 1.923076923076925 (getvar "TEXTSIZE")))) (cons 40 (getvar "TEXTSIZE")) (cons 1 (strcat "OFFSET: " (rtos dy))) ) ) (prin1) )

like this?

Have a look at this, can set say top level. https://help.autodesk.com/view/ACDLT/2025/ENU/?guid=GUID-AD65DF88-5218-4655-B877-B4D33B9FB6D1

This is similar to your request can redo it so it asks for values. I think I have it some where. Perp to 2 pts.lsp

a solution was given on the autodesk forums: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-move-leaders-along-their-length/td-p/12984399

You can try this. This raises a perpendicular in the current UCS from the feature selection point (straight or curved segment). If you want to start from a specific point, force the appropriate osnap object (near, node, etc.) before selecting the object. (defun elperr (ch) (cond ((or (eq ch "Function cancelled") (eq ch "quit / exit abort") (eq ch "console break")) nil) (T (princ ch)) ) (setvar "osmode" old_osmd) (setvar "orthomode" old_orth) (setvar "snapang" old_snp) (setq *error* olderr) (princ) ) (defun c:elp ( / olderr *error* js ent-sel ent pt_sel obj_curv old_osmd old_snp old_orth param deriv pt_tmp p_from p_to) (vl-load-com) (setq olderr *error* *error* elperr) (princ "\nRaise a perpendicular to: ") (while (not (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY")))))) (setq ent-sel (ssnamex js 0) ent (cadar ent-sel) pt_sel (cadar (cdddar ent-sel)) obj_curv (vlax-ename->vla-object ent) ) (cond ((member (vlax-get-property obj_curv 'ObjectName) '("AcDbPolyline" "AcDb2dPolyline" "AcDbLine" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbSpline" "AcDbRay" "AcDbXline") ) (setq old_osmd (getvar "osmode") old_snp (getvar "snapang") old_orth (getvar "orthomode") pt_sel (vlax-curve-getClosestPointTo obj_curv pt_sel) param (vlax-curve-getparamatpoint obj_curv pt_sel) deriv (vlax-curve-getfirstderiv obj_curv param) ) (setq pt_tmp (polar pt_sel (+ (atan (cadr deriv) (car deriv)) (/ pi 2)) 100.0)) (setvar "snapang" (angle (trans pt_sel 0 1) (trans pt_tmp 0 1))) (setvar "orthomode" 1) (if (null (setq p_from (getpoint "\nFrom point <last>: "))) (setq p_from (trans pt_sel 0 1)) ) (setvar "osmode" 0) (initget 9) (setq p_to (getpoint p_from "\nTo the point: ")) (command "_.line" p_from p_to "") (setvar "osmode" old_osmd) (setvar "orthomode" old_orth) (setvar "snapang" old_snp) ) (T (princ "\nInvalid object!")) ) (setq *error* olderr) (princ) )

I'm not sure of your skill with LISP and routines but, use perpendicular snap to draw the line, use entlast to get line definition and an (assoc 11 ....) from that to get point B This line will set snaps to perpendicular: (setvar 'osmode 128) Remembering to record what the were before the LISP and set them back afterwards. This line will give you the start point (setq P1 (getpoint "Draw Line")) This will draw the line (command "line" P1 pause "") This line will give you point P2 on a selected line drawn P1-P2 (princ (cdr (assoc 11 (entget (car (entsel "Select Line")))))) which can be modified to get the last entity drawn (princ (cdr (assoc 11 (entget (entlast))))) and if you want to be a bit clever (defun c:test ( / ) (setq os_Old (getvar 'osmode)) (setvar 'osmode 128) (command "line" pause (setq p2 (getpoint)) "") (setvar 'osmode os_old) (princ p2) (princ) )

_regapp is part of the Purge command it removes unneeded regapps (registered applications). Terry Dotson gives a good explanation HERE... Try QNEW manually, it opens a new drawing and changes focus to that drawing.

Was trying to use VLISP for this, but I also looking into VBA and C#. You may need to go to a more C# specialized forum, though any .NET should be similar enough. Did you even bother looking at the links I posted? Giles is still around on Autodesk Forum and maybe other sites AFAIK. Really just starting with C# and AutoCAD, but from what I have researched you need something along these lines, more of a guideline than working code. using Autodesk.AutoCAD.ApplicationServices; using Autodesk.AutoCAD.DatabaseServices; using Autodesk.AutoCAD.Runtime; using Autodesk.AutoCAD.Geometry; public class BlockVisibilityStates { [CommandMethod("ReadVisibilityStates")] public void ReadVisibilityStates() { Document doc = Application.DocumentManager.MdiActiveDocument; Database db = doc.Database; // Start a transaction using (Transaction tr = db.TransactionManager.StartTransaction()) { // Open the BlockTable for read BlockTable blkTbl = (BlockTable)tr.GetObject(db.BlockTableId, OpenMode.ForRead); // Iterate through each block in the BlockTable foreach (ObjectId blkId in blkTbl) { BlockTableRecord blkRec = (BlockTableRecord)tr.GetObject(blkId, OpenMode.ForRead); // Check if it's a dynamic block if (blkRec.IsDynamicBlock) { // Iterate through the block references foreach (ObjectId objId in blkRec) { if (objId.ObjectClass.Name == "AcDbBlockReference") { BlockReference blkRef = (BlockReference)tr.GetObject(objId, OpenMode.ForRead); // Get the dynamic block reference property collection DynamicBlockReferencePropertyCollection propCollection = blkRef.DynamicBlockReferencePropertyCollection; foreach (DynamicBlockReferenceProperty prop in propCollection) { if (prop.PropertyName == "Visibility") { // Read the visibility state var visibilityState = prop.Value.ToString(); doc.Editor.WriteMessage($"Block: {blkRec.Name}, Visibility State: {visibilityState}\n"); } } } } } } // Commit the transaction tr.Commit(); } } } Untested

(setvar "CMLEADERSTYLE" "YourStyleHere")