Leaderboard

I think it's a good idea that I'm also going to try: leaving a text box with the names of the Lisp commands used to edit a drawing. This new code will filter all of AutoCAD's predefined Lisp commands and, of those loaded by the user, will only consider those that have been used in the drawing. To avoid confusion, replace everything above with this new one. (defun fota (/ arch cad cmd) (defun pregunta (a b / cad) (cond ((= (car b) "CLOSE") (if (and *lstCmds* (= (vlax-invoke-method (vlax-create-object "wscript.shell") 'popup "Print commands on screen?" 0 "Nikon's doubts" 4) 6)) (c:cmdsCargados)) ) ((= (type a) 'VLR-Lisp-Reactor) (if (not (member (setq cad (substr (car b) 4 (- (strlen (car b)) 4))) *lstCmds*)) (setq *lstCmds* (cons (substr (car b) 4 (- (strlen (car b)) 4)) *lstCmds*)) ) ) ) ) (foreach sim (atoms-family 0) (if (wcmatch (setq cmd (strcase (vl-princ-to-string sim) T)) "c:*") (setq *afI* (cons sim *afI*)) ) ) (setq *r* (vlr-command-reactor nil '((:vlr-commandwillStart . pregunta)))) (setq *r1* (vlr-lisp-reactor nil '((:vlr-lispwillstart . pregunta)))) ) (defun c:cmdsCargados (/ cad arch linea) (setq *cadCmds* nil) (foreach sim (atoms-family 0) (if (not (member sim *afI*)) (if (and (wcmatch (setq cad (strcase (vl-princ-to-string sim) T)) "c:*") (member (strcase (substr cad 3)) *lstCmds*) ) (setq *cadCmds* (strcat (if *cadCmds* (strcat *cadCmds* "\n") "\\C1Commands loaded during last sesion:\\C256\n") (substr cad 3))) ) ) ) (if *cadCmds* (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nInsertion point...")) 100 *cadCmds*)) (princ) ) (fota)

Not sure if the lisp by YMG will read 3dfaces. CIV3d will do it same with other civil packages like Civil Site Design.TriangV0.6.7.LSP

Hi, With your drawing, this code will correct the polylines. To be adapted if used in another drawing (ssget filter) (vl-load-com) (defun c:Correct3DPL ( / ss AcDoc Space nb n ename obj l_pt lay new_obj) (setq ss (ssget "_X" '((0 . "POLYLINE") (67 . 0) (8 . "CTL_PNT") (66 . 1) (70 . 9)))) (cond (ss (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) nb 0 ) (repeat (setq n (sslength ss)) (setq ename (ssname ss (setq n (1- n))) obj (vlax-ename->vla-object ename) l_pt (vlax-get obj 'Coordinates) lay (vlax-get obj 'Layer) ) (cond ((eq (length l_pt) 12) (vla-delete obj) (setq new_obj (vlax-invoke Space 'Add3dPoly (cdddr l_pt))) (vla-put-Closed new_obj :vlax-true) (vla-put-Layer new_obj lay) (setq nb (1+ nb)) ) ) ) (princ (strcat "\n" (itoa nb) " polylines corrected.")) ) ) (prin1) )

Lee it is a rare day when I find an improvement for you, and it might be today... might be... In your onsave would it be preferable to take any strings that 'sel' finds in the ssget and append the new commands to them? Maybe put some sort of delimitator between old and new strings? Reason I ask, it is not unusual for me to complete a drawing over a few sessions - end of day into the next day being most common - which means the reactors will be reset... but the commands used will still need to be listed.

Great code, as always, Mr. Lee As for mine, I think I forgot that some reactors are persistent. So, Nikon, the problem is that you must have opened the same drawing several times in the same AutoCAD session, and several prompts have accumulated, repeating the request several times. That problem shouldn't occur anymore with this new code. Also, you'll be able to see the text inserted before confirming the closing of the drawing. Simply replace the "fota" function in your "acad2021Doc.lsp" with this new one. (defun fota (/ arch cad cmd mens) (defun pregunta (a b / cad) (cond ((= (car b) "CLOSE") (if (and *lstCmds* (setq mens (cmdsCargados)) (= (vlax-invoke-method (vlax-create-object "wscript.shell") 'popup "驴Dejar en el dibujo un MTEXT con todos los comandos utilizados?" 0 "Guardar comandos usados" 4) 6) ) (progn (vlr-remove-all) (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nInsertion point...")) 100 mens) (vlax-invoke-method (vlax-get-acad-object) 'Update) ) (vlr-remove-all) ) ) ((= (type a) 'VLR-Lisp-Reactor) (if (not (member (setq cad (substr (car b) 4 (- (strlen (car b)) 4))) *lstCmds*)) (setq *lstCmds* (cons (substr (car b) 4 (- (strlen (car b)) 4)) *lstCmds*)) ) ) ) ) (vlr-remove-all) (foreach sim (atoms-family 0) (if (wcmatch (setq cmd (strcase (vl-princ-to-string sim) T)) "c:*") (setq *afI* (cons sim *afI*)) ) ) (setq *r* (vlr-command-reactor nil '((:vlr-commandwillStart . pregunta)))) (setq *r1* (vlr-lisp-reactor nil '((:vlr-lispwillstart . pregunta)))) )

Here's a quick & dirty version - it's not advisable to prompt the user for any input as part of a reactor callback. (defun init ( ) (foreach grp (vlr-reactors :vlr-command-reactor :vlr-lisp-reactor) (foreach rtr (cdr grp) (if (= "lisp-commands" (vlr-data rtr)) (vlr-remove rtr) ) ) ) (setq lisp-command-list nil) (vlr-command-reactor "lisp-commands" '((:vlr-commandwillstart . onsave))) (vlr-lisp-reactor "lisp-commands" '((:vlr-lispwillstart . onlisp))) (princ) ) (defun onsave ( rtr arg / idx lyr sel str ) (setq lyr "lisp-commands") (cond ( (not arg)) ( (not (wcmatch (setq arg (strcase (car arg))) "SAVE,QSAVE,SAVEAS"))) ( lisp-command-list (if (setq sel (ssget "_X" (list (cons 8 lyr)))) (repeat (setq idx (sslength sel)) (entdel (ssname sel (setq idx (1- idx)))) ) ) (setq str "") (foreach itm (vl-sort lisp-command-list '(lambda ( a b ) (> (cdr a) (cdr b)))) (setq str (strcat str "\\P" (car itm) "\t\t" (itoa (cdr itm)))) ) (makelayer lyr) (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(010 0.0 0.0) (cons 1 (substr str 3)) (cons 8 lyr) ) ) ) ) (princ) ) (defun onlisp ( rtr arg / fun itm ) (cond ( (not arg)) ( (wcmatch (setq arg (strcase (car arg))) "~(C:*)")) ( (setq fun (substr arg 4 (- (strlen arg) 4)) itm (assoc fun lisp-command-list) ) (setq lisp-command-list (subst (cons (car itm) (1+ (cdr itm))) itm lisp-command-list)) ) ( (setq lisp-command-list (cons (cons fun 1) lisp-command-list))) ) (princ) ) (defun makelayer ( lay ) (if (not (tblobjname "layer" lay)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) (cons 2 lay) '(062 . 8) '(290 . 0) ) ) ) ) (vl-load-com) (init)

This tool will be perfect when complemented by another tool that detects this MTEXT and loads the files it refers to. This means that the command name must be the same as the file name. This idea needs to be further developed. It's very interesting. PS: Is it possible that this issue has already been discussed in another thread on this forum?

@GLAVCVS ¡Muchísimas gracias! Thanks a lot! The last code works great! I get a list of used programs. Special thanks for "Nikon's doubts". Now it's the end of my doubts. ¡Buena suerte en nuevos proyectos!

Final edit to prevent the dialog from asking unnecessary questions. Remember: the LISP commands it will remember will be those that have been executed at some point. (defun fota (/ arch cad cmd mens) (defun pregunta (a b / cad) (cond ((= (car b) "CLOSE") (if (and *lstCmds* (setq mens (cmdsCargados)) (= (vlax-invoke-method (vlax-create-object "wscript.shell") 'popup "Print commands on screen?" 0 "Nikon's doubts" 4) 6) ) (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point (getpoint "\nInsertion point...")) 100 mens) ) ) ((= (type a) 'VLR-Lisp-Reactor) (if (not (member (setq cad (substr (car b) 4 (- (strlen (car b)) 4))) *lstCmds*)) (setq *lstCmds* (cons (substr (car b) 4 (- (strlen (car b)) 4)) *lstCmds*)) ) ) ) ) (foreach sim (atoms-family 0) (if (wcmatch (setq cmd (strcase (vl-princ-to-string sim) T)) "c:*") (setq *afI* (cons sim *afI*)) ) ) (setq *r* (vlr-command-reactor nil '((:vlr-commandwillStart . pregunta)))) (setq *r1* (vlr-lisp-reactor nil '((:vlr-lispwillstart . pregunta)))) ) (defun cmdsCargados (/ cad) (setq *cadCmds* nil) (foreach sim (atoms-family 0) (if (not (member sim *afI*)) (if (and (wcmatch (setq cad (strcase (vl-princ-to-string sim) T)) "c:*") (member (strcase (substr cad 3)) *lstCmds*) ) (setq *cadCmds* (strcat (if *cadCmds* (strcat *cadCmds* "\n") "\\C1Commands loaded during last sesion:\\C256\n") (substr cad 3))) ) ) ) *cadCmds* ) (fota)

Here's a quick one: (defun c:foo (/ o s sp) (if (and (setq s (ssget ":L" '((0 . "3DFACE")))) (setq sp (vlax-get (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace ) ) ) ) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (setq o (vlax-invoke sp 'add3dpoly (vlax-get (vlax-ename->vla-object x) 'coordinates))) (progn (entdel x) (vlax-put o 'closed -1)) ) ) ) (princ) ) (vl-load-com)