马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
(defun C:LISTFUNS (/ *error* vars str vtype ans mode item items)
;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
;* *
;* LISTFUNS.LSP by John F. Uhden *
;* 2 Village Road *
;* Sea Girt, NJ 08750 *
;* *
;* * * * * * * * * * * * * * * * * * * * * * * * *
; v2.2 (10-10-00) added (wcmatch) search for both input and (strcase) of input
; v15.00 (04-07-00) for R15
; v15.01 (11-05-01) finally added choices for pageTb saFearray vAriant Vla-Object
; v15.01F (01-04-17) removed security for release as freeware to AutoCAD forum.
;; Function lists all atoms in the (atoms-family) via wildcard match,
;; and let's you restrict the search to atoms of certain types.
(gc)
(prompt "\nLISTFUNS v15.01F (c)1994-2016, John F. Uhden")
(setq items (atoms-family 1)) ; set list before this program adds any items, er atoms.
(defun *error* (err)
(if (= (type fp) 'FILE)
(setq fp (close fp))
)
(mapcar '(lambda (x) (setvar (car x) (cdr x))) vars)
(vla-endundomark *doc*)
(if (wcmatch (strcase err) "*CANCEL*,*QUIT*")
(vl-exit-with-error
"\r "
)
(vl-exit-with-error (strcat "\r*ERROR*: " err))
)
)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
;; Kent Cooper's method is much cleaner, but I am not Kent Cooper, just a fan.
(setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("cmdecho")))
(mapcar '(lambda (x) (setvar (car x) 0)) vars)
(command "_.expert" (getvar "expert"))
;; dummy command
(if (/= (type $cv_lf_str) 'STR)
(setq $cv_lf_str "*")
)
(if (/= (type $cv_lf_file) 'STR)
(setq $cv_lf_file "LISTFUNS.TXT")
)
(if (/= (setq str
(getstring (strcat "\nFunction name(s)/<" $cv_lf_str ">: "))
)
""
)
(setq $cv_lf_str str)
)
(if (not (vl-position
$cv_lf_vtype
'("Exsubr" "eXrxsubr" "File" "Int"
"List" "eName" "paGetb" "Pickset"
"Real" "Safearray" "sTr" "sUbr"
"sYm" "vAriant" "Vla-object"
"*"
)
)
)
(setq $cv_lf_vtype "*")
)
(initget
"Exsubr eXrxsubr File Int List eName paGetb Pickset Real Safearray sTr sUbr sYm vAriant Vla-object *"
)
(setq ans
(getkword
(strcat
"\nVariable Type...\n Exsubr/eXrxsubr/File/Int/List/eName/paGetb/Pickset/Real/Safearray/sTr/sUbr/sYm/vAriant/Vla-object/*, <"
$cv_lf_vtype
">:"
)
)
)
(if ans
(setq $cv_lf_vtype ans)
)
(initget "Append Overwrite No")
(setq ans (getkword "\nWrite to file? Append/Overwrite/<No>: "))
(cond
((= ans "Append") (setq mode "a"))
((= ans "Overwrite") (setq mode "w"))
(1 (setq mode nil))
)
(if (and mode
(setq ans (getfiled "Enter File Name" $cv_lf_file "" 5))
)
(setq $cv_lf_file ans
fp (open $cv_lf_file mode)
)
(setq fp nil)
)
(foreach item items
(if
(and item
(wcmatch item (strcat $cv_lf_str "," (strcase $cv_lf_str)))
(or (= $cv_lf_vtype "*")
(= (type (eval (read item))) (read $cv_lf_vtype))
)
)
(if fp
(progn
(princ (strcat "\n" item "\t") fp)
(prin1 (eval (read item)) fp)
)
(progn
(princ (strcat "\n" item "\t"))
(prin1 (eval (read item)))
)
)
)
)
(*error* nil)
)
(defun c:LF () (c:listfuns))
|