可自由定制的最强劲的刷子

eachy · 发表于 2004-12-26 03:57:34

最初由 aeo 发布
[B]象"自由选"一样，根据选到的物体，出不同的对话框，来个一网打尽. [/B]

好创意，这样设置？

liuyj · 发表于 2004-12-26 15:11:13

这样最好，我本来想用dos_multilist改一改的，可是后来发现pl里的不是字符串，搞了半天也不成。期望斑竹的改进程序早日出炉。

ywx0576 · 发表于 2004-12-26 16:54:41

期待eachy斑竹的改进程序早日共享!

coolyxw · 发表于 2004-12-26 20:58:42

嗯,创意棒,楼主和各位大侠们尽快贴出完美程序来,很想试试

aeo · 发表于 2004-12-26 21:14:15

有个问题

比如0层，红色，画了一line1，颜色随层
1层,黄色, line2,颜色随层

刷的时候，勾了颜色，但没勾图层.
那line2要不要改颜色呢?

cad的刷子是不改的，那不是白刷了吗?

eachy · 发表于 2004-12-26 21:55:37

要改，选了颜色就按颜色值改，不管图层

urljit · 发表于 2004-12-27 19:58:35

我觉得不应该改，毕竟物体的颜色是随层的，cad里面的颜色就是这样使用的。

htonny · 发表于 2004-12-27 20:10:48

不错啊，用起来很方便

charles1hong · 发表于 2004-12-28 18:06:16

希望斑主能想办法团结大家的力量完善它这才是对大家都有利的，呵呵

wkai · 发表于 2004-12-28 18:55:27

在eachy的基础上完成的动态对话框实现版。
12291150更新

;;我也会编程, 可自由定制的最强劲的刷子
;;==============================================================
;;
;; Writen By Eachy Email: [email]eachy@21cn.com[/email] 2004.12.23
;;
;; homepage: [url]www.xdcad.net[/url]
;;
;;==============================================================
;;产生动态对话框,用户供选择 wkai
;;==============================================================
(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2)
(if (= 'ENAME (type e))
(setq e (vlax-ename->vla-object e))
)
(foreach n pl
(if (not (vl-catch-all-error-p
(setq var (vl-catch-all-apply
'vlax-get-property
(list e (car n))
)
)
)
)
(setq pl1 (cons n pl1))
)
)
(setq dcl_name (car (convert_string_to_lst (getenv "ACAD") ";")))
(setq dcl_name (strcat dcl_name "\\easy_matchprop1" ".dcl"))
(SETQ f (OPEN dcl_name "w"))
(write-line
(strcat "ss:dialog{label=""
(vlax-get-property e 'ObjectName)
"";"
)
f
)
(write-line
":toggle{label="全选";key="selectall";}\n:boxed_column{label="需要传递性质";\n"
f
)
(foreach n pl1
(write-line
(strcat ":toggle{label=""
(vl-princ-to-string (cadr n))" " (vl-princ-to-string(vlax-get-property e (car n)))
"";key=""
(vl-princ-to-string (car n))
"";}"
)
f
)
)
(write-line "}ok_only;}" f)
(close f)
(setq index_value (load_dialog dcl_name))
(new_dialog "ss" index_value)
(action_tile "selectall" "(zf:selectall)")
(action_tile "accept" "(zf:check_toggles)")
(defun zf:check_toggles ()
(foreach n pl1
(if (= "1" (get_tile (vl-princ-to-string (car n))))
(setq pl2 (cons (car n) pl2))
)
)
(done_dialog 1)
)
(defun zf:selectall (/ mode)
(setq mode (get_tile "selectall"))
(foreach n pl1
(set_tile (vl-princ-to-string (car n)) mode)
)
)
(setq flag (start_dialog))
(unload_dialog index_value) ;_卸载框
(print pl2)
pl2
)
;;==============================================================
;;改特性的一种通用编程方法，变量名称使用特性名，用 eval 求值
;;==============================================================
(defun ea:put-property (obj plst /)
(mapcar '(lambda (p)
(if (eval p)
(vl-catch-all-apply
'vlax-put-property
(list obj p (eval p))
)
)
)
plst
)
)
;;==============================================================
;;示例
;;用上面的函数可以做出比CAD更最强劲的并可以自由定制的刷子
;; pl 中需要的特性参考联机帮助中各实体 Properties
;;==============================================================
(vl-load-com)
(defun c:ea:mat (/ e ss obj pl olderr myerr eDoc)
(setq pl '(
(color "颜色")
(layer "图层")
(linetype "线型")
(textstring "文字")
(height "高度")
(stylename "样式名")
(textstyle "文字样式")
(rotation "旋转角度")
(thickness "厚度")
(ConstantWidth "宽度")
(patternname "填充样式")
(patternscale "填充比例")
(lineweight "线宽")
(elevation "高度")
(radius "半径")
(xscalefactor "x比例")
(yscalefactor "y比例")
(zscalefactor "z比例")
(Closed "闭合")
) ;_ 此处可根据需要增减
)
(defun myerr (msg)
(if (/= msg "取消")
(princ "\n*取消*")
)
(if pl
(progn
(mapcar '(lambda (x) (set x nil)) pl)
(setq pl nil)
)
)
(vla-endundomark eDoc)
(setq *error* olderr)
(princ)
)
(setq eDoc (vlax-get-property (vlax-get-acad-object) 'activedocument))
(vla-startundomark eDoc)
(setq olderr *error*
*error* myerr
)
(if (and (setq e (car (entsel "\n选择源对象: ")))
(progn
(princ "\n选择目标对象....")
(setq ss (ssget))
)
)
(progn
(setq pl (zf:get_properties e pl))
(setq obj (vlax-ename->vla-object e))
(mapcar '(lambda (p / var)
(if (not (vl-catch-all-error-p
(setq var (vl-catch-all-apply
'vlax-get-property
(list obj p)
)
)
)
)
(set p var)
(set p nil)
)
)
pl
)
(setq ssl (sslength ss))
(while (> ssl 0)
(setq
obj (vlax-ename->vla-object (ssname ss (setq ssl (1- ssl))))
)
(ea:put-property obj pl)
)
(mapcar '(lambda (x) (set x nil)) pl)
(setq pl nil)
)
)
(setq *error* olderr)
(vla-endundomark eDoc)
(princ)
)
(princ "\nWriten By Eachy , From [url]www.xdcad.net[/url]!")
(princ "\nModified By Wkai , From [url]www.xdcad.net[/url]!")
(princ "\n启动命令: ea:mat")
(princ)

;;我也会编程, 可自由定制的最强劲的刷子                     
;;============================================================== 
;;                                                               
;;     Writen By Eachy Email: [email]eachy@21cn.com[/email]   2004.12.23       
;;                                                               
;;              homepage: [url]www.xdcad.net[/url]                         
;; 
;;============================================================== 
;;产生动态对话框,用户供选择  wkai                               
;;============================================================== 
(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2) 
  (if (= 'ENAME (type e)) 
    (setq e (vlax-ename->vla-object e)) 
  ) 
 
  (foreach n pl 
    (if        (not (vl-catch-all-error-p 
               (setq var (vl-catch-all-apply 
                           'vlax-get-property 
                           (list e (car n)) 
                         ) 
               ) 
             ) 
        ) 
      (setq pl1 (cons n pl1)) 
    ) 
  ) 
  (setq dcl_name (car (convert_string_to_lst (getenv "ACAD") ";"))) 
  (setq dcl_name (strcat dcl_name "\\easy_matchprop1" ".dcl")) 
 
  (SETQ f (OPEN dcl_name "w")) 
  (write-line 
    (strcat "ss:dialog{label="" 
            (vlax-get-property e 'ObjectName) 
            "";" 
    ) 
    f 
  ) 
  (write-line 
    ":toggle{label="全选";key="selectall";}\n:boxed_column{label="需要传递性质";\n" 
    f 
  ) 
 
  (foreach n pl1 
    (write-line 
      (strcat ":toggle{label="" 
              (vl-princ-to-string (cadr n))" " (vl-princ-to-string(vlax-get-property e (car n))) 
              "";key="" 
              (vl-princ-to-string (car n)) 
              "";}" 
      ) 
      f 
    ) 
  ) 
  (write-line "}ok_only;}" f) 
  (close f) 
  (setq index_value (load_dialog dcl_name)) 
  (new_dialog "ss" index_value) 
  (action_tile "selectall" "(zf:selectall)") 
  (action_tile "accept" "(zf:check_toggles)") 
  (defun zf:check_toggles () 
    (foreach n pl1 
      (if (= "1" (get_tile (vl-princ-to-string (car n)))) 
        (setq pl2 (cons (car n) pl2)) 
      ) 
    ) 
    (done_dialog 1) 
  ) 
  (defun zf:selectall (/ mode) 
    (setq mode (get_tile "selectall")) 
    (foreach n pl1 
      (set_tile (vl-princ-to-string (car n)) mode) 
 
    ) 
  ) 
  (setq flag (start_dialog)) 
  (unload_dialog index_value) ;_卸载框 
  (print pl2) 
  pl2 
) 
;;============================================================== 
;;改特性的一种通用编程方法，变量名称使用特性名，用 eval 求值    
;;============================================================== 
(defun ea:put-property (obj plst /) 
  (mapcar '(lambda (p) 
             (if (eval p) 
               (vl-catch-all-apply 
                 'vlax-put-property 
                 (list obj p (eval p)) 
               ) 
             ) 
           ) 
          plst 
  ) 
) 
;;============================================================== 
;;示例                                                          
;;用上面的函数可以做出比CAD更最强劲的并可以自由定制的刷子       
;; pl 中需要的特性参考联机帮助中各实体 Properties                
;;============================================================== 
(vl-load-com) 
(defun c:ea:mat (/ e ss obj pl olderr myerr eDoc) 
  (setq        pl '( 
             (color "颜色") 
             (layer "图层") 
             (linetype "线型") 
             (textstring "文字") 
             (height "高度") 
             (stylename "样式名") 
             (textstyle "文字样式") 
             (rotation "旋转角度") 
             (thickness "厚度") 
             (ConstantWidth  "宽度") 
             (patternname "填充样式") 
             (patternscale "填充比例") 
             (lineweight "线宽") 
             (elevation "高度") 
             (radius "半径") 
             (xscalefactor "x比例") 
             (yscalefactor "y比例") 
             (zscalefactor "z比例") 
             (Closed "闭合") 
            ) ;_ 此处可根据需要增减 
  ) 
  (defun myerr (msg) 
    (if        (/= msg "取消") 
      (princ "\n*取消*") 
    ) 
    (if        pl 
      (progn 
        (mapcar '(lambda (x) (set x nil)) pl) 
        (setq pl nil) 
      ) 
    ) 
    (vla-endundomark eDoc) 
    (setq *error* olderr) 
    (princ) 
  ) 
  (setq eDoc (vlax-get-property (vlax-get-acad-object) 'activedocument)) 
  (vla-startundomark eDoc) 
  (setq        olderr        *error* 
        *error*        myerr 
  ) 
  (if (and (setq e (car (entsel "\n选择源对象: "))) 
           (progn 
             (princ "\n选择目标对象....") 
             (setq ss (ssget)) 
           ) 
      ) 
    (progn 
      (setq pl (zf:get_properties e pl)) 
      (setq obj (vlax-ename->vla-object e)) 
      (mapcar '(lambda (p / var) 
                 (if (not (vl-catch-all-error-p 
                            (setq var (vl-catch-all-apply 
                                        'vlax-get-property 
                                        (list obj p) 
                                      ) 
                            ) 
                          ) 
                     ) 
                   (set p var) 
                   (set p nil) 
                 ) 
               ) 
              pl 
      ) 
      (setq ssl (sslength ss)) 
      (while (> ssl 0) 
        (setq 
          obj (vlax-ename->vla-object (ssname ss (setq ssl (1- ssl)))) 
        ) 
        (ea:put-property obj pl) 
      ) 
      (mapcar '(lambda (x) (set x nil)) pl) 
      (setq pl nil) 
    ) 
  ) 
  (setq *error* olderr) 
  (vla-endundomark eDoc) 
  (princ) 
) 
(princ "\nWriten By Eachy , From [url]www.xdcad.net[/url]!") 
(princ "\nModified  By Wkai , From [url]www.xdcad.net[/url]!") 
(princ "\n启动命令: ea:mat") 
(princ)

nihao2002 · 发表于 2004-12-28 20:54:29

给个下载版本好不好啊!!!谢谢

wkai · 发表于 2004-12-29 08:01:30

可以下载的版本

andyhua5240 · 发表于 2004-12-29 08:53:29

谢谢斑竹提供好东东，收下了！
谢谢！
倒！不知道是哪个启动命令才能出现如斑竹的对话框？

liuyj · 发表于 2004-12-29 09:35:25

执行了wkai斑竹的程序，出问题了。

命令: ea:mat
选择源对象:
选择目标对象....
选择对象: 找到 1 个
选择对象:
*取消*; 错误: *error* 函数中出错参数类型错误: symbolp (COLOR "颜色")

再完善一下？

LUCAS · 发表于 2004-12-29 11:39:36

;;因缺函數:CONVERT_STRING_TO_LST
;;但改一下即可
(setq DCL_NAME (getvar "TEMPPREFIX")) ;(car (CONVERT_STRING_TO_LST (getenv "ACAD") ";")))

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

[原创] 可自由定制的最强劲的刷子