vl-catch-all-apply的几例用法

taner · 发表于 2013-8-1 00:21:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 taner 于 2013-8-4 10:33 编辑

(defun Th-Catch-Apply (func params / result)
(if (not (vl-catch-all-error-p (setq result (Vl-Catch-All-Apply func
params
)
)
)
)
result
)
);;;与Vl-Catch-All-Apply用法完全相同
(defun T2-Catch-Apply (lambdafunc / result)
(if (not (vl-catch-all-error-p (setq result (Vl-Catch-All-Apply
(function lambdafunc)
)
)
)
)
result
)
);;;应用范围最广
(defun Bq-Catch-Apply (Lst / res)
(if
(/=
(type
(setq res
(vl-catch-all-apply
(quote (car Lst))
(cdr Lst)
)
)
)
(quote VL-CATCH-ALL-APPLY-ERROR)
)
res
)
)
(defun Tt-Catch-Apply (lst / result)
(if (not (vl-catch-all-error-p
(setq result (Vl-Catch-All-Apply
(list 'lambda 'nil lst)
)
)
)
)
result
)
)
;;;(Tt-Catch-Apply'(vlax-get-property (vlax-ename->vla-object(car(entsel))) 'color))
;;;(Bq-Catch-Apply '(lvlax-get-property (vlax-ename->vla-object(car(entsel))) 'color))
;;;(th-Catch-Apply 'vlax-get-property (list(vlax-ename->vla-object(car(entsel))) 'color))
;;;(t2-Catch-Apply (lambda()(vlax-get-property (vlax-ename->vla-object(car(entsel))) 'color)))

(defun Th-Catch-Apply (func params / result) 
  (if (not (vl-catch-all-error-p (setq result (Vl-Catch-All-Apply func 
                                                                  params 
                                              ) 
                                 ) 
           ) 
      ) 
    result 
  ) 
);;;与Vl-Catch-All-Apply用法完全相同 
(defun T2-Catch-Apply (lambdafunc / result) 
  (if (not (vl-catch-all-error-p (setq result (Vl-Catch-All-Apply 
                                                                  (function lambdafunc) 
                                              ) 
                                 ) 
           ) 
      ) 
    result 
  ) 
);;;应用范围最广 
(defun Bq-Catch-Apply (Lst / res) 
  (if 
    (/= 
      (type 
        (setq res 
          (vl-catch-all-apply 
            (quote (car Lst)) 
            (cdr Lst) 
          ) 
        ) 
      ) 
      (quote VL-CATCH-ALL-APPLY-ERROR) 
    ) 
    res 
  ) 
) 
(defun Tt-Catch-Apply (lst / result) 
  (if (not (vl-catch-all-error-p 
             (setq result (Vl-Catch-All-Apply 
                            (list 'lambda 'nil lst) 
                          ) 
             ) 
           ) 
      ) 
    result 
  ) 
) 
;;;(Tt-Catch-Apply'(vlax-get-property (vlax-ename->vla-object(car(entsel))) 'color)) 
;;;(Bq-Catch-Apply '(lvlax-get-property (vlax-ename->vla-object(car(entsel))) 'color)) 
;;;(th-Catch-Apply  'vlax-get-property (list(vlax-ename->vla-object(car(entsel))) 'color)) 
;;;(t2-Catch-Apply  (lambda()(vlax-get-property (vlax-ename->vla-object(car(entsel))) 'color)))

wowan1314 · 发表于 2013-8-1 09:43:57

感谢分享！

Lispboy · 发表于 2013-8-1 10:06:11

顶楼主，支持分享。

GTJ116600 · 发表于 2013-8-1 14:23:49

看不明白，:P希望楼主给简单讲解讲解

taner · 发表于 2013-8-2 23:02:34

本帖最后由 taner 于 2013-8-3 22:23 编辑

;;;再改一下,这个可以少输入一个LAMBDA,且表里可以有N项表达式
;;;(Catch-Apply '((vlax-put-property (setq o(th2o(car(entsel)))) 'color 1)(vla-put-closed o :vlax-true)))
(defun Catch-Apply (funlstforlambda)
(Th-Catch-Apply (cons 'lambda (cons 'nil funlstforlambda)) nil)
)

Free-Lancer · 发表于 2013-8-3 07:30:27

本来就不太清楚，看完更迷糊了:)来自: Android客户端

/db_自贡黄明儒_ · 发表于 2013-8-8 19:25:38

没明白这样做有什么用。

牢固 · 发表于 2013-8-8 19:56:29

/db_自贡黄明儒_ 发表于 2013-8-8 19:25
没明白这样做有什么用。

;;一般可以这样重定义 VL-CATCH-ALL-APPLY,参数 fun = 执行的函数 lst = 函数fun 的参数表
;;返回结果：函数执行正确，返回函数的结果，函数运行错误，返回 nil
(defun catchapply (fun lst)
(if (not
(VL-CATCH-ALL-ERROR-P
(setq res
(VL-CATCH-ALL-APPLY
(if (= 'SYM (type fun))
fun
(function fun)
)
lst
)
)
)
)
res
)
)
;;
用法一:
(catchapply vla-offset (list (vlax-ename->vla-object (car(entsel))) 1.0))
用法二:
(catchapply 'vla-offset (list (vlax-ename->vla-object (car(entsel))) 1.0))
;;如下用法，参数错误，返回nil
(catchapply vla-offset (list (car(entsel)) 1.0))

taner · 发表于 2013-8-8 22:08:15

本帖最后由 taner 于 2013-8-8 22:26 编辑

(defun catchapply (fun lst)
(if (not (VL-CATCH-ALL-ERROR-P
(setq res (VL-CATCH-ALL-APPLY
(if
(or
(= 'SYM
(type fun)
)
(= 'list
(type fun)
)
)
fun
(function fun)
)
lst
)
)
)
)
res
)
)
;|(catchapply (lambda ()
(vla-put-color (car (vlax-invoke
(vlax-ename->vla-object
(car
(entsel)
)
) 'offset 1.0
)
) 5
)
) nil
)
(catchapply '(lambda ()
(vla-put-color (car (vlax-invoke
(vlax-ename->vla-object
(car
(entsel)
)
) 'offset 1.0
)
) 5
)
) nil
)|;

(defun catchapply (fun lst) 
  (if (not (VL-CATCH-ALL-ERROR-P 
       (setq res (VL-CATCH-ALL-APPLY 
       (if 
         (or 
           (=  'SYM 
        (type fun) 
           ) 
           (=  'list 
        (type fun) 
           ) 
         ) 
          fun 
          (function fun) 
       ) 
       lst 
           ) 
       ) 
     ) 
      ) 
    res 
  ) 
) 
 ;|(catchapply (lambda () 
        (vla-put-color (car (vlax-invoke 
                 (vlax-ename->vla-object 
                       (car 
                      (entsel) 
                       ) 
                 ) 'offset 1.0 
          ) 
           ) 5 
        ) 
      ) nil 
) 
(catchapply '(lambda () 
         (vla-put-color (car (vlax-invoke 
            (vlax-ename->vla-object 
                  (car 
                       (entsel) 
                  ) 
            ) 'offset 1.0 
           ) 
            ) 5 
         ) 
       ) nil 
)|;

taner · 发表于 2013-8-15 03:10:32

(defun Tt-Catch-Apply (expression-wiTh-parenTheses / catch:err)
(setq catch:err (Vl-Catch-All-Apply 'mapcar (cons 'eval (LIst expression-wiTh-parenTheses))))
(if (vl-catch-all-error-p catch:err)
(prompt (strcat "\n" (vl-catch-all-error-message catch:err)
"\n怀具了，执行表达式: "
(vl-princ-to-string expression-wiTh-parenTheses)
"时出错.\n"
)
)
(last catch:err)
)
)
;;;(Tt-catch-apply '((vlax-put-property (setq o(th2o(car(entsel)))) 'color 5)(vla-put-closed o :vlax-true)(vla-get-layer o)))
;;;只能用带单引号的表

cable2004 · 发表于 2014-3-20 22:56:16

源码是好东西

xvjiex · 发表于 2021-6-6 00:15:08

感谢楼主分享vl-catch-all-apply的几例用法！

账号		自动登录	找回密码
密码			立即注册

[每日一码] vl-catch-all-apply的几例用法

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分