[编程申请]：请高手过来编程，属性块文字格式刷

MJJ3468 · 发表于 2005-11-1 10:36:04

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

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

×

各位大大，大家知道CAD的属性文字，可以用刷子改特性(文字样式、字高、宽度比例，图层、颜色等）但成了属性块后就不能了，我想做个可以刷属性块里面的属性文字特性的刷子（就是属性块里面的文字选项和特性，最好能支持多个文字属性，如我附件里的块就有两个文字属性，支持批量窗选，也可全部），要求如下图。
附件里有CAD文件，供大大们参考。
C:\Documents and Settings\administrator\桌面\3.jpg C:\Documents and Settings\administrator\My Documents\My Pictures\2005821107862.gif

MJJ3468 · 发表于 2005-11-2 11:38:56

居然没人理，失望啊。
各位斑竹们，都去那了？

eachy · 发表于 2005-11-2 11:52:55

将你用的CAD版本说说，2000+编程会简单很多。

MJJ3468 · 发表于 2005-11-2 12:56:39

最初由 eachy 发布
[B]将你用的CAD版本说说，2000+编程会简单很多。 [/B]

终于，斑竹理我了，我用的是2004，嘻嘻
谢谢你。eachy

eachy · 发表于 2005-11-2 17:15:03

[php]
(vl-load-com)
(defun c:tt (/ thisdrawing e el ss o myerr olderr attl o1)
 (defun myerr (msg)
(if (/= msg "Cancel")
 (princ "\n*Cancel*")
)
(mapcar '(lambda (x) (set x nil))
 '(stylename height layer color scalefactor)
)
(vla-endundomark thisdrawing)
(setq *error* olderr)
(princ)
 )
 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 (if (and (setq e (car (nentsel "\n拾取文字或属性: ")))
 (setq el (entget e))
 (wcmatch (cdr (assoc 0 el)) "*TEXT,ATT*")
 (progn
 (princ "\n选择文字或属性块...")
 t
 )
 (setq ss (ssget '((-4 . "<or")
 (0 . "*Text")
 (-4 . "<and")
 (0 . "insert")
 (66 . 1)
 (-4 . "and>")
 (-4 . "or>")
 )
 )
 )
 )
(progn
 (setq olderr *error*
 *error* myerr
 )
 (vla-startundomark thisdrawing)
 (setq obj (vlax-ename->vla-object e))
 (mapcar
(function
 (lambda (x)
 (set x (vl-catch-all-apply 'vlax-get-property (list obj x)))
 )
)
'(stylename height layer color scalefactor)
 )
 (vlax-for o (vla-get-activeselectionset
 (vla-get-activedocument (vlax-get-acad-object))
 )
(if (wcmatch (vla-get-objectname o) "*Block*")
 (progn (setq attl (vlax-invoke o 'getattributes))
 (mapcar
 '(lambda (o1)
 (mapcar (function (lambda (x)
 (vl-catch-all-apply
 'vlax-put-property
 (list o1 x (eval x))
 )
)
 )
 '(stylename height layer color scalefactor)
 )
 )
 attl
 )
 )
 (mapcar (function (lambda (x)
 (vl-catch-all-apply
'vlax-put-property
(list o x (eval x))
 )
 )
 )
 '(stylename height layer color scalefactor)
 )
)
 )
 (mapcar '(lambda (x) (set x nil))
 '(stylename height layer color scalefactor)
 )
 (vla-endundomark thisdrawing)
 (setq *error* olderr)
)
 )
 (princ)
)[/php]

MJJ3468 · 发表于 2005-11-2 17:35:13

最初由 eachy 发布
[B][php]
(vl-load-com)
(defun c:tt (/ thisdrawing e el ss o myerr olderr attl o1)
(defun myerr (msg)
(if (/= msg "Cancel")
(princ "\n*Cancel*")
)
(mapcar '(lambda (x) (set x ni... [/B]

斑竹，可以用，可是能不能改进一下，我给的图示中，索引块中不是有两个不同属性号的属性吗，能不能让他各自改各自的(因为上下两个属性有可能特性不同呀），而不是刷了后全部都改成一样了。
哈，谢谢你。★＃★

eachy · 发表于 2005-11-3 22:56:15

(vl-load-com)
(defun c:tt (/ thisdrawing e el o myerr olderr o1 tag bn)
(defun myerr (msg)
(if (/= msg "Cancel")
(princ "\n*Cancel*")
)
(mapcar '(lambda (x) (set x nil))
'(stylename height layer color scalefactor)
)
(vla-endundomark thisdrawing)
(setq *error* olderr)
(princ)
)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(if (and (setq e (entsel "\n拾取属性文字: "))
(setq el (entget (car e)))
(assoc 66 el)
(= (cdr (assoc 0 el)) "INSERT")
(setq bn (assoc 2 el))
(setq e (car (nentselp (last e)))
el (entget e)
)
(equal (assoc 0 el) '(0 . "ATTRIB"))
(progn
(princ "\n选择属性块...")
t
)
(ssget (list bn))
)
(progn
(setq olderr *error*
*error* myerr
)
(vla-startundomark thisdrawing)
(setq obj (vlax-ename->vla-object e)
tag (vla-get-tagstring obj)
)
(mapcar
(function
(lambda (x)
(set x (vl-catch-all-apply 'vlax-get-property (list obj x)))
)
)
'(stylename height layer color scalefactor)
)
(vlax-for o (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(mapcar
'(lambda (o1)
(mapcar (function (lambda (x)
(if
(= (vla-get-tagstring o1)
tag
)
(vl-catch-all-apply
'vlax-put-property
(list o1 x (eval x))
)
)
)
)
'(stylename height layer color scalefactor)
)
)
(vlax-invoke o 'getattributes)
)
)
(mapcar '(lambda (x) (set x nil))
'(stylename height layer color scalefactor)
)
(vla-endundomark thisdrawing)
(setq *error* olderr)
)
)
(princ)
)

(vl-load-com) 
(defun c:tt (/ thisdrawing e el o myerr olderr o1 tag bn) 
  (defun myerr (msg) 
    (if        (/= msg "Cancel") 
      (princ "\n*Cancel*") 
    ) 
    (mapcar '(lambda (x) (set x nil)) 
            '(stylename height layer color scalefactor) 
    ) 
    (vla-endundomark thisdrawing) 
    (setq *error* olderr) 
    (princ) 
  ) 
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) 
  (if (and (setq e (entsel "\n拾取属性文字: ")) 
           (setq el (entget (car e))) 
           (assoc 66 el) 
           (= (cdr (assoc 0 el)) "INSERT") 
           (setq bn (assoc 2 el)) 
           (setq e  (car (nentselp (last e))) 
                 el (entget e) 
           ) 
           (equal (assoc 0 el) '(0 . "ATTRIB")) 
           (progn 
             (princ "\n选择属性块...") 
             t 
           ) 
           (ssget (list bn)) 
      ) 
    (progn 
      (setq olderr  *error* 
            *error* myerr 
      ) 
      (vla-startundomark thisdrawing) 
      (setq obj        (vlax-ename->vla-object e) 
            tag        (vla-get-tagstring obj) 
      ) 
      (mapcar 
        (function 
          (lambda (x) 
            (set x (vl-catch-all-apply 'vlax-get-property (list obj x))) 
          ) 
        ) 
        '(stylename height layer color scalefactor) 
      ) 
      (vlax-for        o (vla-get-activeselectionset 
                    (vla-get-activedocument (vlax-get-acad-object)) 
                  ) 
        (mapcar 
          '(lambda (o1) 
             (mapcar (function (lambda (x) 
                                 (if 
                                   (= (vla-get-tagstring o1) 
                                      tag 
                                   ) 
                                    (vl-catch-all-apply 
                                      'vlax-put-property 
                                      (list o1 x (eval x)) 
                                    ) 
                                 ) 
 
                               ) 
                     ) 
                     '(stylename height layer color scalefactor) 
             ) 
           ) 
          (vlax-invoke o 'getattributes) 
        ) 
      ) 
      (mapcar '(lambda (x) (set x nil)) 
              '(stylename height layer color scalefactor) 
      ) 
      (vla-endundomark thisdrawing) 
      (setq *error* olderr) 
    ) 
  ) 
  (princ) 
)

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

[编程申请]：请高手过来编程，属性块文字格式刷

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

相关帖子