Vlax-Invoke vlax-get vlax-put三合一

Free-Lancer · 发表于 2013-11-29 12:16:45

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

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

×

本帖最后由 Free-Lancer 于 2013-11-29 13:58 编辑

Vlax-invoke 和 Vlax-Get 及 vlax-put 三合一

(defun invoke (obj name var / tf)
(if (and (setq tf (vlax-method-applicable-p obj name)) var)
(vl-catch-all-apply
'vlax-invoke
(append (list obj name) var)
)
(if (null var)
(if tf
(vlax-invoke obj name)
(vlax-get obj name)
)
(progn
(vl-catch-all-apply 'vlax-put (list obj name var))
obj
)
)
)
)

配套函数

(defun fy:acapp nil
(eval (list 'defun
'fy:acapp
'nil
(vlax-get-acad-object)
)
)
(fy:acapp)
)
(defun Fy:acDoc nil
(eval (list 'defun
'FY:acdoc
'nil
(vla-get-activedocument (vlax-get-acad-object))
)
)
(fy:acdoc)
)
(defun FY:acMs nil
(eval (list 'defun
'FY:acMs
'nil
(vla-get-modelspace (FY:acdoc))
)
)
(FY:acMs)
)
(defun e2o (e)
(if (eq (type e) 'ENAME)
(vlax-ename->vla-object e)
e
)
)

1 (invoke (fy:acms) 'Addline (list (getpoint) (getpoint))) ;绘制直线
2 (invoke (e2o (car (entsel))) 'Textstring nil);获取文字字符
3 (invoke (fy:acms) 'AddLightweightpolyline (fy:acms) (list (apply 'appdend (pnt:cutz pts)))) ;点表绘制 pline

/db_自贡黄明儒_ · 发表于 2013-11-29 13:29:38

太有才了！！！

Free-Lancer · 发表于 2013-11-29 13:59:32

本帖最后由 Free-Lancer 于 2013-11-29 14:02 编辑

/db_自贡黄明儒_ 发表于 2013-11-29 13:29
太有才了！！！

更新一下，改为三合一

命令: (invoke (e2o (car (entsel))) 'Startpoint (getpoint))

选择对象: nil

命令: (invoke (e2o (car (entsel))) 'Startpoint nil)

选择对象: (-7.60847e+010 -1.05471e+010 0.0)

下次更新，支持列表

Free-Lancer · 发表于 2013-11-29 16:02:41

支持多属性效果
命令: (invoke (e2o (entlast)) '(startpoint endpoint color layer thickness linetype) nil)
((-513.271 -223.469 0.0) (-37.2793 429.718 0.0) 256 "0" 0.0 "ByLayer")

命令: (invoke (e2o (entlast)) '(color startpoint endpoint) (list 1 (getpoint) (getpoint)))
(#<VLA-OBJECT IAcadLine 1484a07c> #<VLA-OBJECT IAcadLine 1484a07c> #<VLA-OBJECT IAcadLine 1484a07c>)

xshrimp · 发表于 2013-11-29 16:39:09

泼点冷水,这样写,程序的可读性会下降吧.

Free-Lancer · 发表于 2013-11-29 17:13:38

本帖最后由 Free-Lancer 于 2013-11-29 17:15 编辑

xshrimp 发表于 2013-11-29 16:39
泼点冷水,这样写,程序的可读性会下降吧.

要对 ActiveX 熟悉才行，部分 getpropertyvalue + setpropertyvalue 合一

;;****************************************************************;
;;;---------------------------------------------------------------;
;;;功能: vlax-invoke + vlax-get + vlax-put ;
;;; var -- nil 为获取 ;
;;; 修改时和 Name 要一一对应 ;
;;;限制: Get 或 Put 属性时不能有两个及以上参数 ;
;;; 如 coordinate ;
;;;---------------------------------------------------------------;
(defun invoke (obj name var / tf sinvoke val)
(defun sinvoke (obj name var / tf)
(if (and (setq tf (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-method-applicable-p
(list obj name)
)
)
)
var
)
(if (vl-catch-all-apply
'vlax-invoke
(append (list obj name) var)
)
obj
tf
)
(if (null var)
(if tf
(if (not (vl-catch-all-error-p
(setq val
(vl-catch-all-apply 'vlax-invoke (list obj name))
)
)
)
val
nil
)
(if (not (vl-catch-all-error-p
(setq
val (vl-catch-all-apply 'vlax-get (list obj name))
)
)
)
val
nil
)
)
(progn
(vl-catch-all-apply 'vlax-put (list obj name var))
obj
)
)
)
)
(cond
((and (listp name) (not (null var)))
(mapcar '(lambda (x y)
(sinvoke obj x y)
)
name
var
)
)
((listp name)
(mapcar '(lambda (x)
(sinvoke obj x var)
)
name
)
)
(t (sinvoke obj name var))
)
)

;;****************************************************************; 
;;;---------------------------------------------------------------; 
;;;功能: vlax-invoke + vlax-get + vlax-put                        ; 
;;; var -- nil 为获取                                             ; 
;;;        修改时和 Name 要一一对应                               ; 
;;;限制: Get 或 Put 属性时不能有两个及以上参数                    ; 
;;;      如 coordinate                                            ; 
;;;---------------------------------------------------------------; 
(defun invoke (obj name var / tf sinvoke val) 
  (defun sinvoke (obj name var / tf) 
    (if        (and (setq tf (vl-catch-all-error-p 
                        (vl-catch-all-apply 
                          'vlax-method-applicable-p 
                          (list obj name) 
                        ) 
                      ) 
             ) 
             var 
        ) 
      (if (vl-catch-all-apply 
            'vlax-invoke 
            (append (list obj name) var) 
          ) 
        obj 
        tf 
      ) 
      (if (null var) 
        (if tf 
          (if (not (vl-catch-all-error-p 
                     (setq val 
                            (vl-catch-all-apply 'vlax-invoke (list obj name)) 
                     ) 
                   ) 
              ) 
            val 
            nil 
          ) 
          (if (not (vl-catch-all-error-p 
                     (setq 
                       val (vl-catch-all-apply 'vlax-get (list obj name)) 
                     ) 
                   ) 
              ) 
            val 
            nil 
          ) 
        ) 
        (progn 
          (vl-catch-all-apply 'vlax-put (list obj name var)) 
          obj 
        ) 
      ) 
    ) 
  ) 
  (cond 
    ((and (listp name) (not (null var))) 
     (mapcar '(lambda (x y) 
                (sinvoke obj x y) 
              ) 
             name 
             var 
     ) 
    ) 
    ((listp name) 
      (mapcar '(lambda (x) 
                      (sinvoke obj x var) 
                    ) 
                   name 
           ) 
      ) 
    (t (sinvoke obj name var)) 
  ) 
)

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

[研讨] Vlax-Invoke vlax-get vlax-put三合一

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

评分

点评

点评