(("Application (RO) =" #<VLA-OBJECT IAcadApplication 00007ff796ce44f8>)
("Area =" 4807.45)
("Center =" (2831.45 1200.59 0.0))
("Circumference =" 245.789)
("Diameter =" 78.2371)
....
....
)
(vl-princ-to-string (vlax-dump-object (vlax-ename->vla-object (car (entsel))) t))
(defun vlax-dump-object->list ( obj mth )
(append
(list
(mapcar
(function
(lambda ( prp )
(list prp (vlax-get obj prp))
)
)
(_GetObjectProperties obj)
)
)
(if mth (list (_GetObjectMethods obj)))
)
)
(defun _GetObjectProperties ( obj )
(vl-remove-if-not
(function
(lambda ( prp )
(vlax-property-available-p obj prp)
)
)
(_GetVlaProperties)
)
)
(defun _GetObjectMethods ( obj )
(vl-remove-if-not
(function
(lambda ( mth )
(vlax-method-applicable-p obj mth)
)
)
(_GetVlaMethods)
)
)
(defun _GetVlaAtoms ( )
(eval
(list 'defun '_GetVlaAtoms '( )
(list 'quote
(vl-sort
(vl-remove-if-not
(function
(lambda ( sym )
(wcmatch (vl-symbol-name sym) "vla`-*")
)
)
(atoms-family 0)
)
(function
(lambda ( a b )
(<
(vl-symbol-name a)
(vl-symbol-name b)
)
)
)
)
)
)
)
(_GetVlaAtoms)
)
(defun _GetVlaProperties ( )
(eval
(list 'defun '_GetVlaProperties '( )
(list 'quote
(mapcar
(function
(lambda ( sym )
(substr (vl-symbol-name sym) 9)
)
)
(vl-remove-if-not
(function
(lambda ( sym )
(wcmatch (strcase (vl-symbol-name sym)) "VLA`-GET`-*")
)
)
(_GetVlaAtoms)
)
)
)
)
)
(_GetVlaProperties)
)
(defun _GetVlaMethods ( )
(eval
(list 'defun '_GetVlaMethods '( )
(list 'quote
(mapcar
(function
(lambda ( sym )
(substr (vl-symbol-name sym) 5)
)
)
(vl-remove-if
(function
(lambda ( sym )
(wcmatch (strcase (vl-symbol-name sym)) "VLA`-GET`-*,VLA`-PUT`-*")
)
)
(_GetVlaAtoms)
)
)
)
)
)
(_GetVlaMethods)
)
(vl-load-com) (princ)
(defun C:test ( / e o StrMark opn row LstRows rest n itm str LstDump newf newopn a )
(while (not (setq e (car (entsel "\nSelect object to dump to file: ")))) e)
(if (setq o (vlax-ename->vla-object e))
(progn
(SetVarP SysVars2 'cmdecho 0)
(setq StrMark (rtos (rem (getvar 'date) 1) 2 10))
(setvar 'LOGFILEMODE 1)
(princ (strcat "\n" StrMark "\n"))
(princ)
(foreach x (entget e) (print x)(princ "\n"))
(princ "\n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n")
(princ)
(vlax-dump-object o T)
(princ)
(setvar 'LOGFILEMODE 0)
(if (setq opn (open (getvar 'LOGFILENAME) "r"))
(progn (while (setq row (read-line opn)) (if (> (strlen row) 0) (setq LstRows (cons row LstRows)))) (close opn))
)
(if LstRows (progn (setq LstRows (reverse LstRows)) (setq LstRows (cdr (member StrMark LstRows)))))
(ListAlertEach LstRows)
(if
(and
LstRows
(setq newf (getfiled "Create New TXT File" "" "txt" 1))
(setq newopn (open newf "w"))
)
(progn
(foreach x LstRows (write-line x newopn))
(close newopn)
(or a (setq a "Yes")) (initget "Yes No Y N")
(setq a (cond ((getkword (strcat "\nDo you want to open the TXT file? [Yes/No] <" a ">: "))) ( a )))
(if (member (strcase a) '("Y" "YES")) (startapp "explorer" newf))
); progn
); if
); progn
); if o
(princ)
);| defun |; (vl-load-com) (princ)
(defun SetVarP ( SysVarLst VarName Val ); <- UNTESTED !
(and
(= 'LIST (type SysVarLst))
(if (not (zerop (length SysVarLst))) (apply 'and (mapcar '(lambda (x) (= (length x) 3)) SysVarLst)))
(member VarName (mapcar 'car SysVarLst))
(not (vl-catch-all-error-p (vl-catch-all-apply 'setvar (list VarName Val))))
)
);| defun SetVarP |; (vl-load-com) (princ)
(defun ListPrintEach ( Lst ) (if (listp Lst) (foreach x Lst (princ "\n") (print x))) (princ))
(defun ListAlertEach ( Lst ) (if (listp Lst) (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-princ-to-string x))) Lst)))) (princ))
Entget, and Dump with option to save as TXT file, the only problem is that the List is contained entirely of strings._$ (vlax-dump-object->list (vlax-ename->vla-object (car (entsel))) nil)
Error: Invalid number of parameters
_1$
Here's the original code posted about 11 years ago: link (https://www.theswamp.org/index.php?topic=8163.msg104627#msg104627).WTH MP?!
In before the deluge.
Wrote this back in 2010, first incarnation originated about 6 years prior.
Tim is an awesome programmer and artist.
< ... > (sorry, no vid available):
Don't know about awesome but I'm stubborn and determined.IMO Thats a part from the definition of being awesome programmer.
The original was actually a dll I wrote using Visual Studio 6 enterprise. Mid 90's. It was slick and very graphical (icons for each data type) using a listview widget and was good for a couple versions, then knackered by Autodesk. Rewrote it in lisp exploiting a std type library dll. Worked for years then knackered again. Rewrote again in 2010 pure lisp. Fingers crossed its not knackered for awhile.So you were rolling with a few languages, I thought once you started with one language you continue(d) with it.
I remember a time when a whiff of a hint was appreciated.
don't get me started ....
I remember a time when a whiff of a hint was appreciated.
don't get me started ....
The internet has become a demanding mistress?
; Coordinate = ...Indexed contents not shown...
The list will turn it to:("Coordinate" nil)
(defun c:LM_DumpObject (/ prop&methods)
;; Dumps Selected Object in a DCL Box having two List Boxes, one containing Object Properties and second containing Object Methods
;; Courtesy Lee Mac
;; Source : https://www.theswamp.org/index.php?topic=52409.0
(vl-load-com)
;| -------------------------------------------------------------------------
------------------------------------------------------------------------------
FUNCTION DEFINITIONS
------------------------------------------------------------------------------
------------------------------------------------------------------------------
|;
;;
(defun vlax-dump-object->list (obj mth)
(if (eq 'VLA-OBJECT (type obj))
(append (list
(mapcar (function
(lambda (prp / prpval)
(if (not (vl-catch-all-error-p (setq prpval (vl-catch-all-apply 'vlax-get (list obj prp)))))
(list prp prpval)
(list prp nil)
)
)
)
(_GetObjectProperties obj)
)
)
(if mth
(list (_GetObjectMethods obj))
)
)
)
)
;;
(defun _GetObjectProperties (obj)
(vl-remove-if-not (function (lambda (prp) (vlax-property-available-p obj prp))) (_GetVlaProperties))
)
;;
(defun _GetObjectMethods (obj)
(vl-remove-if-not (function (lambda (mth) (vlax-method-applicable-p obj mth))) (_GetVlaMethods))
)
;;
(defun _GetVlaAtoms ()
(eval (list 'defun
'_GetVlaAtoms
'()
(list 'quote
(vl-sort (vl-remove-if-not
(function (lambda (sym) (wcmatch (vl-symbol-name sym) "vla`-*")))
(atoms-family 0)
)
(function (lambda (a b) (< (vl-symbol-name a) (vl-symbol-name b))))
)
)
)
)
(_GetVlaAtoms)
)
;;
(defun _GetVlaProperties ()
(eval
(list 'defun
'_GetVlaProperties
'()
(list 'quote
(mapcar (function (lambda (sym) (substr (vl-symbol-name sym) 9)))
(vl-remove-if-not
(function (lambda (sym) (wcmatch (strcase (vl-symbol-name sym)) "VLA`-GET`-*")))
(_GetVlaAtoms)
)
)
)
)
)
(_GetVlaProperties)
)
;;
(defun _GetVlaMethods ()
(eval
(list 'defun
'_GetVlaMethods
'()
(list 'quote
(mapcar (function (lambda (sym) (substr (vl-symbol-name sym) 5)))
(vl-remove-if
(function (lambda (sym) (wcmatch (strcase (vl-symbol-name sym)) "VLA`-GET`-*,VLA`-PUT`-*")))
(_GetVlaAtoms)
)
)
)
)
)
(_GetVlaMethods)
)
;;
(defun LM:ListBox2 (lis1 lis2 / DCH DCL DES)
;; Makes two List Boxes, each filled with supplied lists
;; lis1 : List1 to be appended in Left List Box
;; lis2 : List2 to be appended in Right List Box
(defun *error* (msg)
(if (and (= 'int (type dch)) (< 0 dch))
(unload_dialog dch)
)
(if (= 'file (type des))
(close des)
)
(if (and (= 'str (type dcl)) (setq dcl (findfile dcl)))
(vl-file-delete dcl)
)
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(if
(and
(setq dcl (vl-filename-mktemp "tmp.dcl"))
(setq des (open dcl "w"))
(write-line
(strcat
"listbox : list_box { }
example : dialog { label = \"Dump Object\"; spacer; : row {
: listbox { key = \"ls1\"; label = \"Properties\"; width = 50; height = 20; fixed_width = false; fixed_height = false; multiple_select = false ; }
: column {}
: listbox { key = \"ls2\"; label = \"Methods\"; width = 30; height = 20; fixed_width = false; fixed_height = false; multiple_select = false ; }}
ok_only;}"
)
des
)
(not (setq des (close des)))
(< 0 (setq dch (load_dialog dcl)))
(new_dialog "example" dch)
)
(progn (if lis1
(progn (start_list "ls1")
(foreach itm lis1
(add_list (strcat (vl-princ-to-string (car itm)) " = " (vl-princ-to-string (cadr itm))))
)
(end_list)
)
)
(if lis2
(progn (start_list "ls2") (foreach itm lis2 (add_list itm)) (end_list))
)
(start_dialog)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (setq dcl (findfile dcl))
(vl-file-delete dcl)
)
(princ)
)
;;
;| -------------------------------------------------------------------------
------------------------------------------------------------------------------
ACTUAL PROGRAM STARTED
------------------------------------------------------------------------------
------------------------------------------------------------------------------
|;
(setq prop&methods (vlax-dump-object->list (vlax-ename->vla-object (car (entsel))) T))
(LM:ListBox2 (car prop&methods) (cadr prop&methods))
(princ)
)
By the way Andrea, I had a similar idea. However I'm a "hobby programmer" so wrote only this (BrowseThruDictionaries - starting from the namedobjdict):You may be interested in this post then, as it is an entity walker program (not a full as MP's though): https://www.theswamp.org/index.php?topic=51751.0
<snip>
Tim is an awesome programmer and artist.Thanks MP (for the compliment and all the help along the way).