跨文档取数据，跨dwg取数据

dcl1214 · 发表于 2020-7-6 22:06:35

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

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

x

(defun $get-obj-i-doc$
(doc-i filter LST / ax:BuildFilter dc sss ss tmp ent data)
; 这个函数是跨文档读取块参照
; filter 过滤器，例如 (list '(0 . "INSERT") '(2 . "模块*"))
; ($get-obj-v-all$ 1)
(setq dc (vl-catch-all-apply
'vla-item
(list (vla-get-documents (vlax-get-acad-object)) doc-i)
)
)
(if (not (vl-catch-all-error-p dc))
(progn
(setq sss (vl-catch-all-apply 'VLA-GET-SelectionSets (list dc)))
(if (not (vl-catch-all-error-p sss))
(progn
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list sss "new1"))
)
nil
(vl-catch-all-apply
'vla-delete
(list (vl-catch-all-apply 'vla-item (list sss "new1")))
)
)
(setq ss (vl-catch-all-apply 'vla-add (list sss "new1")))
(if (not (vl-catch-all-error-p ss))
(progn
(setq
tmp (mapcar
(function (lambda (lst typ)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
typ
(cons 0 (1- (length lst)))
)
lst
)
)
)
)
(list (mapcar 'car filter) (mapcar 'cdr filter))
(list vlax-vbInteger vlax-vbVariant)
)
)
(vla-select
ss
acSelectionSetAll
nil
nil
(car tmp)
(cadr tmp)
)
(vlax-for ent ss (setq data (cons ent data)))
(vl-catch-all-apply 'vla-delete (list ss))
(if data
(setq data (reverse data))
)
)
)
)
)
)
)
data
)
(setq data ($get-obj-i-doc$ 0 '((0 . "INSERT") (2 . "模块*")) NIL))
(setq
datas (mapcar (function
(lambda (obj / vs tbl v)
(if (and (setq v
(vl-catch-all-apply
'vlax-variant-value
(list (vla-GetAttributes obj))
)
)
(not (vl-catch-all-error-p v))
(setq tbl (vl-catch-all-apply
'vlax-safearray->list
(list v)
)
)
(not (vl-catch-all-error-p tbl))
)
(setq vs (mapcar
(function
(lambda (x)
(cons (vla-get-tagstring x)
(vla-get-textstring
x
)
)
)
)
tbl
)
)
)
vs
)
)
data
)
)
(setq datas (vl-remove nil datas))

(defun $get-obj-i-doc$ 
       (doc-i filter LST / ax:BuildFilter dc sss ss tmp ent data) 
                                        ;  这个函数是跨文档读取块参照 
                                        ; filter 过滤器，例如 (list '(0 . "INSERT") '(2 . "模块*")) 
                                        ;  ($get-obj-v-all$ 1) 
  (setq        dc (vl-catch-all-apply 
             'vla-item 
             (list (vla-get-documents (vlax-get-acad-object)) doc-i) 
           ) 
  ) 
  (if (not (vl-catch-all-error-p dc)) 
    (progn 
      (setq sss (vl-catch-all-apply 'VLA-GET-SelectionSets (list dc))) 
      (if (not (vl-catch-all-error-p sss)) 
        (progn 
          (if (vl-catch-all-error-p 
                (vl-catch-all-apply 'vla-item (list sss "new1")) 
              ) 
            nil 
            (vl-catch-all-apply 
              'vla-delete 
              (list (vl-catch-all-apply 'vla-item (list sss "new1"))) 
            ) 
          ) 
          (setq ss (vl-catch-all-apply 'vla-add (list sss "new1"))) 
          (if (not (vl-catch-all-error-p ss)) 
            (progn 
              (setq 
                tmp (mapcar 
                      (function        (lambda        (lst typ) 
                                  (vlax-make-variant 
                                    (vlax-safearray-fill 
                                      (vlax-make-safearray 
                                        typ 
                                        (cons 0 (1- (length lst))) 
                                      ) 
                                      lst 
                                    ) 
                                  ) 
                                ) 
                      ) 
                      (list (mapcar 'car filter) (mapcar 'cdr filter)) 
                      (list vlax-vbInteger vlax-vbVariant) 
                    ) 
              ) 
              (vla-select 
                ss 
                acSelectionSetAll 
                nil 
                nil 
                (car tmp) 
                (cadr tmp) 
              ) 
              (vlax-for ent ss (setq data (cons ent data))) 
              (vl-catch-all-apply 'vla-delete (list ss)) 
              (if data 
                (setq data (reverse data)) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  data 
) 
(setq data ($get-obj-i-doc$ 0 '((0 . "INSERT") (2 . "模块*")) NIL)) 
(setq 
  datas        (mapcar        (function 
                  (lambda (obj / vs tbl v) 
                    (if        (and (setq v 
                                    (vl-catch-all-apply 
                                      'vlax-variant-value 
                                      (list (vla-GetAttributes obj)) 
                                    ) 
                             ) 
                             (not (vl-catch-all-error-p v)) 
                             (setq tbl (vl-catch-all-apply 
                                         'vlax-safearray->list 
                                         (list v) 
                                       ) 
                             ) 
                             (not (vl-catch-all-error-p tbl)) 
                        ) 
                      (setq vs (mapcar 
                                 (function 
                                   (lambda (x) 
                                     (cons (vla-get-tagstring x) 
                                           (vla-get-textstring 
                                             x 
                                           ) 
                                     ) 
                                   ) 
                                 ) 
                                 tbl 
                               ) 
                      ) 
                    ) 
                    vs 
                  ) 
                ) 
                data 
        ) 
) 
(setq datas (vl-remove nil datas))

Lisphk · 发表于 2020-7-7 03:06:39

如果能不打开DWG，就能读就更好了

xvjiex · 发表于 4 天前

感谢楼主分享跨文档取数据，跨dwg取数据

weizx2000 · 发表于 4 天前

谢谢分享谢谢分享

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

[每日一码] 跨文档取数据，跨dwg取数据

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