不开图修改属性块信息

dcl1214 · 发表于 2021-4-1 23:19:27

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

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

×

(defun $修改外部DWG中属性块信息$
(path BLOCKNAME TAG-VALUE
LST / dbxdoc
dbxmodelspace tags
data v
)
;属性块属性标记，外部dwg属性标记
(if path
(progn
(setq
DBXDOC
(vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar 'acadver) 1 2)
)
)
)
(cond
((vl-catch-all-error-p
(vl-catch-all-apply
'vla-Open
(list DBXDOC path)
)
)
(princ (strcat "无法打开图纸: " path))
)
(t
(setq DBXModelSpace
(vl-catch-all-apply 'vla-get-ModelSpace (LIST DBXDOC))
)
)
)
(if DBXModelSpace
(setq
data
(vl-catch-all-apply
(FUNCTION
(lambda (/ array-value data km objname tags tbl v wz ss)
(vlax-for item DBXModelSpace
(if (and (setq objname (vl-catch-all-apply
'vla-get-objectname
(list item)
)
)
(= objname "AcDbBlockReference")
)
(progn
(setq v nil)
(or (and (setq km (vl-catch-all-apply
'vla-get-effectivename
(list item)
)
)
(not (vl-catch-all-error-p km))
)
(and (setq km (vl-catch-all-apply
'vla-get-name
(list item)
)
)
(not (vl-catch-all-error-p km))
)
(setq km nil)
)
(if (and km
BLOCKNAME
(wcmatch km
(strcat (strcase BLOCKNAME)
","
(strcase BLOCKNAME t)
)
)
)
(PROGN
(if
(and
(setq array-value
(vl-catch-all-apply
'vlax-variant-value
(list (vla-GetAttributes item))
)
)
(not
(vl-catch-all-error-p array-value)
)
(setq tbl (vl-catch-all-apply
'vlax-safearray->list
(list array-value)
)
)
(not (vl-catch-all-error-p tbl))
)
(progn
(setq ss
(mapcar
(function
(lambda (x / tag put-v s v-o)
(if
(and (setq
tag
(vla-get-tagstring x)
)
(setq s
(vl-some
(function
(lambda (x)
(if (= (car x)
tag
)
x
)
)
)
TAG-VALUE
)
)
)
(progn
(setq
v-o (vla-get-TextString x)
)
(setq put-v (cdr s))
(vla-put-TextString x put-v)
(if
(= (vla-get-TextString x)
put-v
)
(progn
(setq s '())
(setq s
(cons (cons "字段" tag)
s
)
)
(setq s
(cons (cons "原值" v-o)
s
)
)
(setq s
(cons (cons "新值" put-v)
s
)
)
)
)
)
)
s
)
)
tbl
)
)
(vl-catch-all-apply
'vla-saveas
(list DBXDOC path)
)
)
)
)
)
)
)
)
ss
)
)
)
)
)
(vlax-release-object DBXDOC) ;关闭打开的图纸
)
)
data
)

(defun $修改外部DWG中属性块信息$ 
         (path       BLOCKNAME  TAG-VALUE 
          LST       /    dbxdoc 
          dbxmodelspace    tags 
          data       v 
         ) 
          ;属性块属性标记，外部dwg属性标记 
  (if path 
    (progn 
      (setq 
  DBXDOC 
   (vla-getinterfaceobject 
     (vlax-get-acad-object) 
     (strcat "ObjectDBX.AxDbDocument." 
       (substr (getvar 'acadver) 1 2) 
     ) 
   ) 
      ) 
      (cond 
  ((vl-catch-all-error-p 
     (vl-catch-all-apply 
       'vla-Open 
       (list DBXDOC path) 
     ) 
   ) 
   (princ (strcat "无法打开图纸: " path)) 
  ) 
  (t 
   (setq DBXModelSpace 
    (vl-catch-all-apply 'vla-get-ModelSpace (LIST DBXDOC)) 
   ) 
  ) 
      ) 
      (if DBXModelSpace 
  (setq 
    data 
     (vl-catch-all-apply 
       (FUNCTION 
         (lambda (/ array-value data km objname tags tbl v wz ss) 
     (vlax-for item  DBXModelSpace 
       (if (and (setq objname (vl-catch-all-apply 
              'vla-get-objectname 
              (list item) 
            ) 
          ) 
          (= objname "AcDbBlockReference") 
           ) 
         (progn 
           (setq v nil) 
           (or (and  (setq km (vl-catch-all-apply 
             'vla-get-effectivename 
             (list item) 
           ) 
        ) 
        (not (vl-catch-all-error-p km)) 
         ) 
         (and  (setq km (vl-catch-all-apply 
             'vla-get-name 
             (list item) 
           ) 
        ) 
        (not (vl-catch-all-error-p km)) 
         ) 
         (setq km nil) 
           ) 
           (if (and  km 
        BLOCKNAME 
        (wcmatch km 
           (strcat (strcase BLOCKNAME) 
             "," 
             (strcase BLOCKNAME t) 
           ) 
        ) 
         ) 
       (PROGN 
         (if 
           (and 
             (setq array-value 
              (vl-catch-all-apply 
          'vlax-variant-value 
          (list (vla-GetAttributes item)) 
              ) 
             ) 
             (not 
         (vl-catch-all-error-p array-value) 
             ) 
             (setq tbl (vl-catch-all-apply 
             'vlax-safearray->list 
             (list array-value) 
           ) 
             ) 
             (not (vl-catch-all-error-p tbl)) 
           ) 
            (progn 
        (setq ss 
               (mapcar 
           (function 
             (lambda (x / tag put-v s v-o) 
               (if 
                 (and (setq 
                  tag 
                   (vla-get-tagstring x) 
                ) 
                (setq s 
                 (vl-some 
                   (function 
                     (lambda (x) 
                 (if (=  (car x) 
                  tag 
                     ) 
                   x 
                 ) 
                     ) 
                   ) 
                   TAG-VALUE 
                 ) 
                ) 
                 ) 
            (progn 
              (setq 
                v-o  (vla-get-TextString x) 
              ) 
              (setq put-v (cdr s)) 
              (vla-put-TextString x put-v) 
              (if 
                (= (vla-get-TextString x) 
                   put-v 
                ) 
                 (progn 
                   (setq s '()) 
                   (setq s 
                    (cons (cons "字段" tag) 
                    s 
                    ) 
                   ) 
                   (setq s 
                    (cons (cons "原值" v-o) 
                    s 
                    ) 
                   ) 
                   (setq s 
                    (cons (cons "新值" put-v) 
                    s 
                    ) 
                   ) 
                 ) 
              ) 
            ) 
               ) 
               s 
             ) 
           ) 
           tbl 
               ) 
        ) 
        (vl-catch-all-apply 
          'vla-saveas 
          (list DBXDOC path) 
        ) 
            ) 
         ) 
       ) 
           ) 
         ) 
       ) 
     ) 
     ss 
         ) 
       ) 
     ) 
  ) 
      ) 
      (vlax-release-object DBXDOC)  ;关闭打开的图纸 
    ) 
  ) 
  data 
)

weizx2000 · 发表于 2021-4-2 00:57:26

谢谢分享谢谢分享

greatxs · 发表于 2021-4-2 08:14:29

好动画系啊

hbwr123 · 发表于 2021-4-2 09:20:38

学习到了！！！！！

bai0371 · 发表于 2021-4-2 10:26:12

怎么使用啊

cghdy · 发表于 2021-4-2 11:09:18

好像用不了了，LST参数也没出现，能不能具体点用法

aisong220 · 发表于 2021-4-3 09:09:46

Michael527 · 发表于 2021-4-5 17:17:44

思路不错，看看效果如何，谢谢分享

xk15c · 发表于 2021-4-6 04:53:32

神操作哇！摩拜

janshyl · 发表于 2021-4-6 08:01:29

有時需要不開圖修改感謝樓主分享

yangjian001 · 发表于 2021-4-7 09:37:49

做一个热心并受欢迎的人

yangjian001 · 发表于 2021-4-7 09:56:29

做一个热心并受欢迎的人

SHUNDocker · 发表于 2021-4-7 10:02:15

感谢楼主分享学习！！！

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

[源码] 不开图修改属性块信息

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