TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: mkweaver on May 07, 2007, 07:25:16 PM
-
I want to get a list of object properties. I know I can do a vlax-dump-object, but I want these property names into a list so I can iterate over them. Something along the lines of:
(mapcar '(lambda (propertyname)
(vlax-put-property objTarget prop (vlax-get-property objSource prop))
)
(listallobjectproperties objSource)
)
It's the "listallobjectproperties" I'm trying to figure out. I suppose I could use vlax-dump-object, grab the results from the log file and parse it, but I'm sure hoping there's a better way.
Thanks in advance,
Mike Weaver
-
One way would be to create a list of every possible, writeable, property, then use a (mapcar) & (vlax-property-available-p) to determine if it's a valid property for the object. I say writeable, because there's no reason to check for Read-Only props if you are copying them from one object to another.
-
Look here:
http://www.theswamp.org/index.php?topic=8163.0
-
Cab,
Thanks for the link. That is just the kind of information I was hoping to find.
Off to bury myself in parens...
-
Hi Mike
Here is my old one
Hth
~'J'~
; With help by Peter Ciganek
; 3/7/05 10:39 PM ;
//////////// ////////////
//////////// /////////////
///// ///// /////
///// ///// /////
///// //////////////
///// /////////////
///// ///// ////
///// ///// ////
//////// ///// ////// ////
/////// ///// ///// ////
; Display object properties and methods ;
; helpers:
;; ;;
(defun initax ()
(vl-load-com)
(or acapp (setq acapp (vlax-get-acad-object)))
(or adoc (setq adoc (vla-get-activedocument acapp)))
(cond ((= (vlax-variant-value
(vla-getvariable adoc "TILEMODE")) 1)
(or mdsp (setq mdsp (vla-get-modelspace adoc))))
((= (vlax-variant-value
(vla-getvariable adoc "TILEMODE")) 0)
(or mdsp (setq mdsp (vla-get-paperspace adoc))))))
(defun my-propts ()
(mapcar (function (lambda (x)
(substr x 9)))
(vl-remove-if-not
(function (lambda (x)
(wcmatch (strcase x) "VLA-GET-*")))
(atoms-family 1))))
;; ;;
(defun my-methods ()
(mapcar (function (lambda (x)
(substr x 5)))
(vl-remove-if-not (function (lambda (x)
(and (wcmatch (strcase x) "VLA-*")
(not (wcmatch (strcase x) "VLA-GET-*,VLA-PUT-*")))))
(atoms-family 1))))
;; ;;
(defun my-err-msg (func_lambda / ret)
(setq ret (vl-catch-all-apply (function (lambda () func_lambda))))
(if (and (vl-catch-all-error-p ret))
(apply (list (vl-catch-all-error-message ret))
)
ret
)
)
;; ;;
(defun my-catch (a)
(vl-catch-all-apply (function (lambda () a ))))
;; ;;
(defun my-obj (en)
(my-err-msg (vlax-ename->vla-object en)))
(defun my-sel-obj (msg / ent)
(setvar "ERRNO" 0)
(while
(and (not (setq ent (entsel msg)))
(equal 7 (getvar "ERRNO"))
)
(setvar "ERRNO" 0)
)
(cond
((equal (getvar "ERRNO") 52) nil)
(T (my-obj (car ent)))))
;; ;;
(defun my-make-props-dcl ()
(gc)
(setq fname (strcat (getvar "DWGPREFIX") "objprops.dcl"))
(setq fn (open fname "w"))
(write-line (strcat "selobj : dialog { label = " mark ";") fn)
(write-line "spacer_0;" fn)
(write-line ": boxed_row {" fn)
(write-line ": list_box {" fn)
(write-line (strcat "label = " "\"" "*** PROPERTIES / VALUES ***" "\"" ";") fn)
(write-line (strcat "key = " "\"" "elist1" "\"" ";") fn)
(write-line (strcat "width = 45; height = 20;}") fn)
(write-line ": list_box {" fn)
(write-line (strcat "label = " "\"" "*** METHODS ***" "\"" ";") fn)
(write-line (strcat "key = " "\"" "elist2" "\"" ";") fn)
(write-line (strcat "width = 30; height = 20;}") fn)
(write-line "}" fn)
(write-line "spacer_0;" fn)
(write-line "ok_only; " fn)
(write-line "spacer_0;" fn)
(write-line ": text_part {" fn)
(write-line (strcat "value = " "\"" "© Designed by Fatty T.O.H." "\"" ";") fn)
(write-line "alignment = left; }" fn)
(write-line "spacer_0;" fn)
(write-line ": text_part {" fn)
(write-line (strcat "value = " "\"" "// From man to man //" "\"" ";") fn)
(write-line "alignment = right; }" fn)
(write-line "}" fn)
(close fn)
)
; ;
(defun my-props-and-methods ( / en elist elistn tmp)
(setq vobj (my-sel-obj "\nSelect object : >>> \n")
pr_list (acad_strlsort
(vl-remove-if-not (function (lambda (x)
(vlax-property-available-p vobj x)))
(my-propts)))
met_list (acad_strlsort
(vl-remove-if-not (function (lambda (x)
(vlax-method-applicable-p vobj x)))
(my-methods)))
val_list (mapcar (function (lambda(a)(if (not (member a '("COORDINATE" "BULGE")))
(vlax-get-property vobj a)
"NOT AVAILABLE")))
pr_list)
data_list (mapcar (function (lambda(p q)(strcat p " " " <*> : "
(vl-princ-to-string q)))) pr_list val_list)
mark (substr (strcase (vla-get-objectname vobj)) 5)
)
(my-make-props-dcl)
(setq dcl_ix (load_dialog "objprops.dcl"))
(new_dialog "selobj" dcl_ix)
(start_list "elist1")
(mapcar 'add_list data_list)
(end_list)
(start_list "elist2")
(mapcar 'add_list met_list)
(end_list)
(if (= (start_dialog) 1)
nil
)
(vl-file-delete fname)
(princ)
)
(defun C:bxp ()
(setvar "cmdecho" 0)
(initax)
(my-props-and-methods)
(setvar "cmdecho" 1)
(princ)
)
(prompt "\nType BXP to execute ... \n")
(princ)
-
Thanks, I'll take a look at it.
Mike