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

bluesky1000 · 发表于 2004-12-29 12:11:54

宽度不能刷，当我把PL的宽度传到普通直线的时候不行，能否加强一下。

wkai · 发表于 2004-12-29 14:28:32

可以显示原始物体的属性

bluesky1000 · 发表于 2004-12-29 14:53:19

是可以显示宽度值，但不能刷呀。斑竹能否再加强一下呢？
这个程序真的是很有新意。

wkai · 发表于 2004-12-29 15:05:17

程序只将通用的属性传递到目标物体上，而不是所有属性。希望把一条直线刷成圆弧么？

wkai · 发表于 2004-12-29 15:12:34

最初由 aeo 发布
[B]有个问题

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

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

cad的刷子是不改的，那不是白刷了吗? [/B]

不改更合理。

阿龙197811 · 发表于 2004-12-29 15:44:43

为什么使用文字刷后,在刷其他属性时文字也改变?

wkai · 发表于 2004-12-30 12:03:13

1自动获得样本实体的所有可操作属性(小心dim类实体，属性超多)
2将样板实体的属性分为public 和 private

;;我也会编程, 可自由定制的最强劲的刷子
;;==============================================================
;;
;; Writen By Eachy Email: [email]eachy@21cn.com[/email] 2004.12.23
;;
;; homepage: [url]www.xdcad.net[/url]
;;
;;==============================================================
;;获取某一个实体所有可用属性 petersciganek
;;[url]http://discussion.autodesk.com/thread.jspa?messageID=3941641[/url]
;;==============================================================
(defun f:vl-property-available (en)
(setq en (f:enx en))
(vl-remove-if-not
(function (lambda (x) (vlax-property-available-p en x t)))
(f:vla-getlist)
)
)
(defun f:vla-getlist ()
(cond
(*vla-getlist*)
((setq *vla-getlist*
(mapcar (function (lambda (x) (substr x 9)))
(vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1))
)
) ;setq
)
)
)
(defun f:vla-methodlist ()
(cond
(*vla-methodlist*)
((setq *vla-methodlist*
(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-*"))
) ;and
)
)
(atoms-family 1)
)
)
) ;setq
)
) ;cond
)
(defun f:vl-method-applicable (en)
(setq en (f:enx en))
(vl-remove-if-not
(function (lambda (x) (vlax-method-applicable-p en x)))
(f:vla-methodlist)
)
)
(defun f:enx (en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object en)
en
)
)
;;==============================================================
;;产生动态对话框,用户供选择 wkai
;;==============================================================
(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2 pl0 )
;;;======================================================
(defun zf:format_str (a b)
(print a)
(princ " ")
(princ (type a))
(setq a (vl-princ-to-string a))
(if (> (strlen a) b)
(setq a (strcat (substr a 1 (- b 1)) "."))
(repeat (- b (strlen a) ) (setq a (strcat a " ")))
)
a
)
;;;======================================================
(defun zf:check_toggles ()
(foreach n pl0
(if (= "1" (get_tile (vl-princ-to-string (if (listp n)(car n)n))))
(setq pl2 (cons (if (listp n)(car n)n) pl2))
)
)
(done_dialog 1)
)
;;;======================================================
(defun zf:selectall (str pl1 / mode)
(setq mode (get_tile str))
(foreach n pl1
(set_tile (vl-princ-to-string (if (listp n)(car n)n)) mode)
)
)
;;;======================================================
(defun zf:get_rows(n / lst)
(cond
((< n 6)(setq b 1))
((< n 18)(setq b 2))
(t(setq b 3))
)
(setq c (1+ (fix (/ n b 1.0)))
m 1
)
(while (<= m c)
(setq r (rem n m))
(if (or (= r 0)(> r (* 0.7 m)))(setq lst (cons m lst) ))
(setq m (1+ m))
)
(car lst)
)
;;;======================================================
(if (= 'ENAME (type e))
(setq e (vlax-ename->vla-object e))
)
(setq pl (f:vl-property-available e))
(foreach n pl
(if (not (vl-catch-all-error-p
(setq var (vl-catch-all-apply
'vlax-get-property
(list e (if (listp n)(car n)n))
)
)
)
)
(setq pl0 (cons n pl0))
)
)
(setq pl0 (mapcar 'read (vl-sort pl0 '<)))
(setq pl1 pl0)
(setq pl '((color "Color")
(layer "Layer")
(linetype "线型")
(lineweight "线宽")
(LinetypeScale "线型比例")
(PlotStyleName "打印样式")
) ;_ 此处可根据需要增减
)
(foreach n pl
(setq pl1 (vl-remove (car n) pl1) )
)
(setq m 0
o (zf:get_rows (length pl1))
)
(or o (setq o 20) )
(setq oo (fix(/ (length pl1) o 1.0) ))
(if(>(rem (length pl1) o )0)(setq oo (1+ oo)))
(setq oo (cadr (assoc oo '((1 6)(2 3)(3 2)(4 2)(5 2)(6 1)))))
(or oo (setq oo 1))
(setq DCL_NAME (getvar "TEMPPREFIX"))
(setq dcl_name (strcat dcl_name "easy_matchprop" ".dcl"))
(SETQ f (OPEN dcl_name "w"))
(write-line
(strcat "ss:dialog{label=""
(vlax-get-property e 'ObjectName)
"";"
)
f
)
(write-line
":boxed_row{label="Public Props";\n:column{"
f
)
(foreach n pl
(setq m (1+ m))
(if (> m oo)
(progn (setq m 1) (write-line "}\n:column{" f))
)
(write-line
(strcat ":toggle{label=""
(zf:format_str
(if (listp n)
(cadr n)
n
)
15
)
":"
(zf:format_str
(vlax-get-property
e
(if (listp n)
(car n)
n
)
)
15
)
"";key=""
(vl-princ-to-string
(if (listp n)
(car n)
n
)
)
"";}"
)
f
)
)
(repeat (- oo m)(write-line ":spacer{}" f))
(write-line "}}:boxed_row{label="Private Props";\n:column{" f)
(setq m 0)
(foreach n pl1
(setq m (1+ m))
(if (> m o)
(progn (setq m 1) (write-line "}\n:column{" f))
)
(write-line
(strcat ":toggle{label=""
(zf:format_str (if (listp n)(cadr n)n)15)":" (zf:format_str (vlax-get-property e (if (listp n)(car n)n))15)
"";key=""
(vl-princ-to-string (if (listp n)(car n)n))
"";}"
)
f
)
)
(repeat (- o m)(write-line ":spacer{}" f))
(write-line "}}:row{:toggle{label="Public Props";key="selectall";}:toggle{label="Private Props";key="selectall1";}ok_only;}}" f)
(close f)
(setq index_value (load_dialog dcl_name))
(new_dialog "ss" index_value)
(action_tile "selectall" "(zf:selectall "selectall" pl)")
(action_tile "selectall1" "(zf:selectall "selectall1" pl1)")
(action_tile "accept" "(zf:check_toggles)")
(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)
(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选择源对象: ")))
(setq pl (zf:get_properties e pl))
(progn
(princ "\n选择目标对象....")
(setq ss (ssget))
)
)
(progn
(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]                         
;;                                                               
;;============================================================== 
;;获取某一个实体所有可用属性  petersciganek                      
;;[url]http://discussion.autodesk.com/thread.jspa?messageID=3941641[/url]   
;;============================================================== 
(defun f:vl-property-available (en) 
  (setq en (f:enx en)) 
          (vl-remove-if-not 
            (function (lambda (x) (vlax-property-available-p en x t))) 
            (f:vla-getlist) 
          ) 
) 
(defun f:vla-getlist () 
  (cond 
    (*vla-getlist*) 
    ((setq *vla-getlist* 
            (mapcar (function (lambda (x) (substr x 9))) 
                    (vl-remove-if-not (function (lambda (x) (wcmatch (strcase x) "VLA-GET-*"))) (atoms-family 1)) 
            ) 
     )                                        ;setq 
    ) 
  ) 
) 
(defun f:vla-methodlist        () 
  (cond 
    (*vla-methodlist*) 
    ((setq *vla-methodlist* 
            (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-*")) 
                                  )        ;and 
                                ) 
                      ) 
                      (atoms-family 1) 
                    ) 
            ) 
     )                                        ;setq 
    ) 
  )                                        ;cond 
) 
(defun f:vl-method-applicable (en) 
  (setq en (f:enx en)) 
  (vl-remove-if-not 
    (function (lambda (x) (vlax-method-applicable-p en x))) 
    (f:vla-methodlist) 
  ) 
) 
(defun f:enx (en) 
  (if (= (type en) 'ENAME) 
    (vlax-ename->vla-object en) 
    en 
  ) 
) 
;;============================================================== 
;;产生动态对话框,用户供选择  wkai                               
;;============================================================== 
(defun zf:get_properties (e pl / DCL_NAME E F FLAG INDEX_VALUE PL1 VAR pl2 pl0 ) 
  ;;;====================================================== 
  (defun zf:format_str (a b) 
    (print a) 
    (princ " ") 
    (princ (type a)) 
    (setq a (vl-princ-to-string a)) 
    (if        (> (strlen a) b) 
      (setq a (strcat (substr a 1 (- b 1)) ".")) 
      (repeat (- b (strlen a) )  (setq  a (strcat a " ")))       
    ) 
    a 
  ) 
  ;;;====================================================== 
  (defun zf:check_toggles () 
    (foreach n pl0 
      (if (= "1" (get_tile (vl-princ-to-string (if (listp n)(car n)n)))) 
        (setq pl2 (cons (if (listp n)(car n)n) pl2)) 
      ) 
    ) 
    (done_dialog 1) 
  ) 
  ;;;====================================================== 
  (defun zf:selectall (str pl1 / mode) 
    (setq mode (get_tile str)) 
    (foreach n pl1 
      (set_tile (vl-princ-to-string (if (listp n)(car n)n)) mode) 
 
    ) 
  ) 
  ;;;====================================================== 
  (defun zf:get_rows(n / lst) 
  (cond 
    ((< n 6)(setq b 1)) 
    ((< n 18)(setq b 2))    
    (t(setq b 3))    
    ) 
  (setq        c (1+ (fix (/ n b 1.0))) 
        m 1 
  ) 
(while (<= m c) 
  (setq r (rem n m)) 
  (if (or (= r 0)(> r (* 0.7 m)))(setq lst (cons m lst) )) 
  (setq m (1+ m))   
  )   
  (car lst) 
  ) 
  ;;;====================================================== 
  (if (= 'ENAME (type e)) 
    (setq e (vlax-ename->vla-object e)) 
  ) 
  (setq pl (f:vl-property-available e)) 
  (foreach n pl 
    (if        (not (vl-catch-all-error-p 
               (setq var (vl-catch-all-apply 
                           'vlax-get-property 
                           (list e (if (listp n)(car n)n)) 
                         ) 
               ) 
             ) 
        ) 
      (setq pl0 (cons n pl0)) 
    ) 
  ) 
  (setq pl0 (mapcar 'read (vl-sort  pl0 '<))) 
  (setq pl1 pl0) 
  (setq        pl '((color "Color") 
             (layer "Layer") 
             (linetype "线型") 
             (lineweight "线宽") 
             (LinetypeScale "线型比例") 
             (PlotStyleName "打印样式") 
            ) ;_ 此处可根据需要增减 
  ) 
  (foreach n pl 
    (setq pl1 (vl-remove (car n) pl1) ) 
    ) 
  (setq        m 0 
        o (zf:get_rows (length pl1)) 
  ) 
  (or o (setq o 20) ) 
  (setq oo (fix(/ (length pl1) o 1.0) )) 
  (if(>(rem (length pl1) o )0)(setq oo (1+ oo))) 
  (setq oo (cadr (assoc oo '((1 6)(2 3)(3 2)(4 2)(5 2)(6 1))))) 
  (or oo (setq oo 1))        
  (setq DCL_NAME (getvar "TEMPPREFIX")) 
  (setq dcl_name (strcat dcl_name "easy_matchprop" ".dcl")) 
  (SETQ f (OPEN dcl_name "w")) 
  (write-line 
    (strcat "ss:dialog{label="" 
            (vlax-get-property e 'ObjectName) 
            "";" 
    ) 
    f 
  ) 
  (write-line 
    ":boxed_row{label="Public Props";\n:column{" 
    f 
  ) 
(foreach n pl 
    (setq m (1+ m)) 
    (if        (> m oo) 
      (progn (setq m 1) (write-line "}\n:column{" f)) 
    ) 
    (write-line 
      (strcat ":toggle{label="" 
              (zf:format_str 
                (if (listp n) 
                  (cadr n) 
                  n 
                ) 
                15 
              ) 
              ":" 
              (zf:format_str 
                (vlax-get-property 
                  e 
                  (if (listp n) 
                    (car n) 
                    n 
                  ) 
                ) 
                15 
              ) 
              "";key="" 
              (vl-princ-to-string 
                (if (listp n) 
                  (car n) 
                  n 
                ) 
              ) 
              "";}" 
      ) 
      f 
    ) 
  ) 
  (repeat (- oo m)(write-line ":spacer{}" f)) 
  (write-line "}}:boxed_row{label="Private Props";\n:column{" f) 
  (setq m 0) 
  (foreach n pl1 
    (setq m (1+ m)) 
    (if        (> m o) 
      (progn (setq m 1) (write-line "}\n:column{" f)) 
    ) 
    (write-line 
      (strcat ":toggle{label="" 
              (zf:format_str (if (listp n)(cadr n)n)15)":" (zf:format_str (vlax-get-property e (if (listp n)(car n)n))15) 
              "";key="" 
              (vl-princ-to-string (if (listp n)(car n)n)) 
              "";}" 
      ) 
      f 
    ) 
  ) 
  (repeat (- o m)(write-line ":spacer{}" f)) 
  (write-line "}}:row{:toggle{label="Public Props";key="selectall";}:toggle{label="Private Props";key="selectall1";}ok_only;}}" f) 
  (close f) 
  (setq index_value (load_dialog dcl_name)) 
  (new_dialog "ss" index_value) 
  (action_tile "selectall" "(zf:selectall "selectall" pl)") 
  (action_tile "selectall1" "(zf:selectall "selectall1" pl1)") 
  (action_tile "accept" "(zf:check_toggles)") 
  (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) 
  (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选择源对象: "))) 
           (setq pl (zf:get_properties e pl)) 
           (progn 
             (princ "\n选择目标对象....") 
             (setq ss (ssget)) 
           ) 
      ) 
    (progn       
      (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)

liuyj · 发表于 2004-12-30 14:02:32

这个爽！功能太强了！唯一不足的就是英文太多，想找一个需要的属性要好半天。

乐逍遥 · 发表于 2004-12-30 18:37:02

功能强大，但英文确实太多,有中文提示版就就好了

梦断江南 · 发表于 2004-12-30 21:26:44

[iframe h=600]http://discussion.autodesk.com/thread.jspa?threadID=344100[/iframe]

aeo · 发表于 2004-12-31 02:46:20

太复杂了反而不好用

要做大量的翻译工作
TextGenerationFlag HorizontalAlignment 怎么翻译合适?

hatch的"填充样式"没了
(vlax-property-available-p en x t) 是t的关系

梦断江南 · 发表于 2004-12-31 14:06:59

还是用英文吧，免得产生岐义

烨006 · 发表于 2005-1-1 21:49:24

一头雾水！有什么用处？

xjlmlxbq · 发表于 2005-1-4 16:53:04

大开眼界，收益不浅

coolyxw · 发表于 2005-1-10 12:25:22

能不能推出个完美版的？这个可是好东西啊，各位高手们来完善完善

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

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