ObjectDBX方法批量插入路径下dwg文件插入点问题

yaojing38 · 发表于 2024-8-29 13:29:20

;;;ObjectDBX方法批量插入路径下dwg文件
(defun c:bins () (c:BatchInsert))
(princ "\nObjectDBX方法批量插入路径下dwg文件,By Gu_xl 命令: bins")
(defun c:BatchInsert ()
(
(lambda
(path files / dbxdoc dbxModelSpace all t1)
(GXL-SYS-PROGRESS-INIT "" (length files))
(foreach dwg files
(GXL-SYS-PROGRESS (length files) -1)
;(command "insert" (strcat "*" path "\" dwg) '(0 0 0) 1 0)
(setq dbxdoc (gxl-GetDocumentObject (strcat path "\" dwg)))
(setq dbxModelSpace (vla-get-ModelSpace dbxdoc))
(setq all (GXL-ITEMSALL dbxModelSpace))
(gxl-CopyObjects all dbxdoc nil)
)
(gxl-Sys-Progress-Done)
)
(setq path (GXL-FILE-GETFOLDER "选取文件夹"))
(
(lambda (path)
(if path
(VL-DIRECTORY-FILES path "*.dwg" 1)
)
)
path
)
)
(princ)
)
;;;(gxl-GetDocumentObject filename) 获取DWG文件的Document 对象
(defun gxl-GetDocumentObject (filename / acdocs dbx acVer)
(vlax-map-collection
(vla-get-Documents (vlax-get-acad-object))
(function
(lambda (doc)
(setq acdocs
(cons
(cons (strcase (vla-get-fullname doc)) doc)
acdocs
)
)
)
)
)
(cond
((not (setq filename (findfile filename))) nil)
((cdr (assoc (strcase filename) acdocs)))
((not
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-open
(list (setq dbx
(vla-GetInterfaceObject
(vlax-get-acad-object)
(if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
"ObjectDBX.AxDbDocument"
(strcat "ObjectDBX.AxDbDocument." (itoa acVer))
)
)
)
filename
)
)
)
)
dbx
)
) ;_ cond
)
;;;gxl-ItemsAll collection )返回集合全部成员表
(defun gxl-ItemsAll (collection / result)
(vl-catch-all-apply
(FUNCTION
(lambda ()
(vlax-for item collection (setq result (cons item result)))
(reverse result)
)
)
)
result
)
;;;(gxl-CopyObjects 对象表/图元表/选择集/ENAME/Object 对象宿主拷贝目标宿主(nil 默认当前空间))
;;;(gxl-CopyObjects (ssget) *ACDOCUMENT* (vla-Item (vla-get-Blocks *ACDOCUMENT*) (GXL-DXF (car (GXL-SEL-ENTSEL "选择图块:" '((0 . "insert")))) 2)))
(defun gxl-CopyObjects ( lst owner dest )
(cond ((= 'List (type lst))
(setq lst (mapcar '(lambda (x) (if (= 'ename (type x)) (vlax-ename->vla-object x) x)) lst))
)
( (= 'pickset (type lst)) (setq lst (GXL-SEL-SS->VLA lst)))
( (= 'ename (type lst)) (setq lst (list (vlax-ename->vla-object lst))))
( (= 'vla-object (type lst)) (setq lst (list lst)))
)
(if (null dest) (setq dest (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace))))
(vla-CopyObjects owner (GXL-NUM-OBJECTVARIANT lst) dest)
)
;;;(gxl-num-ObjectVariant vla对象表) 创建vla变体
(defun gxl-num-ObjectVariant ( lst )
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject
(cons 0 (1- (length lst)))
)
lst
)
)
)
;;;;;;gxl-sel-ss->vla 选择集转为Vla列表
(defun gxl-sel-ss->vla ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
)
)
)
;;; 进程条初始化 (gxl-Sys-Progress-Init 提示进程总数)
;;; 进程步进 (gxl-Sys-Progress 进程总数 -1)
;;; 进程结束 (gxl-Sys-Progress-Done)
(setq *ProgressID* 0
*ProgressPrompt* ""
*ProgressBFB* " 0%")
(defun gxl-Sys-Progress-Init (str to)
(if *FlagINIT* (alert "上一次进程条没有结束！"))
(setq *ProgressID* 0
*ProgressTo* to
*ProgressPrompt* str
*ProgressBFB* 2
*FlagINIT* T)
)
(defun gxl-Sys-Progress-Done ()
(setq *ProgressID* 0
*ProgressTo* nil
*ProgressPrompt* ""
*ProgressBFB* 2
*FlagINIT* nil)
(setvar "modemacro" "")
)
(defun gxl-Sys-Progress (to i / CS_TEXT MYI bfb corstate LL)
(if (not *FlagINIT*)
(gxl-Sys-Progress-Init "" 100)
)
(if (and *FlagINIT* *ProgressTo*)
(setq to *ProgressTo*)
)
(setq cs_text "████████████████████"
LL (strlen cs_text)
)
(if (<= i 0)
(setq i (- *ProgressID* i)
*ProgressID* i
)
(setq *ProgressID* i)
)
(if (> i to)
(setq i to)
)
(setq myi (fix (/ (* (strlen cs_text) i) to))
myi (* 2 (/ myi 2))
)
(if (= 0 myi)
(setq myi 2)
)
(setq bfb (fix (* 100 i (/ 1.0 to))))
(if (/= *ProgressBFB* bfb)
(progn
(setq *ProgressBFB* bfb)
(setq
cs_text (substr cs_text 1 myi)
cs_text (strcat cs_text (gxl-Str-Space (- LL myi)))
)
(setq bfb (itoa bfb))
(cond
((= 1 (strlen bfb))
(setq bfb (strcat " " bfb "% "))
)
((= 2 (strlen bfb)) (setq bfb (strcat " " bfb "% ")))
((= 3 (strlen bfb)) (setq bfb (strcat bfb "% ")))
)
(setvar "modemacro"
(strcat *ProgressPrompt*
"已完成"
cs_text
bfb
)
)
)
)
)
;;; gxl-Str-Space 制造空格字串
(defun gxl-Str-Space (n / zf)
(if (< n 1)
(setq zf "")
(progn
(setq zf "")
(repeat n
(setq zf (strcat " " zf))
)
)
)
)
;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil
(defun gxl-file-GetFolder (msg / WinShell shFolder path catchit)
(setq winshell (vlax-create-object "Shell.Application"))
(setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
(setq
catchit (vl-catch-all-apply
'(lambda ()
(setq shFolder (vlax-get-property shFolder 'self))
(setq path (vlax-get-property shFolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path
)
)

;;;ObjectDBX方法批量插入路径下dwg文件 
(defun c:bins () (c:BatchInsert)) 
(princ "\nObjectDBX方法批量插入路径下dwg文件,By Gu_xl 命令: bins") 
(defun c:BatchInsert () 
  ( 
   (lambda 
     (path files / dbxdoc dbxModelSpace all t1) 
      (GXL-SYS-PROGRESS-INIT "" (length files)) 
      (foreach dwg files 
        (GXL-SYS-PROGRESS (length files) -1) 
      ;(command "insert" (strcat "*" path "\" dwg) '(0 0 0) 1 0) 
        (setq dbxdoc (gxl-GetDocumentObject (strcat path "\" dwg))) 
        (setq dbxModelSpace (vla-get-ModelSpace dbxdoc)) 
        (setq all (GXL-ITEMSALL dbxModelSpace)) 
        (gxl-CopyObjects all dbxdoc nil) 
      ) 
      (gxl-Sys-Progress-Done) 
   ) 
(setq path (GXL-FILE-GETFOLDER "选取文件夹")) 
 
    ( 
     (lambda (path) 
       (if path 
         (VL-DIRECTORY-FILES path "*.dwg" 1) 
       ) 
     ) 
     path 
    ) 
  ) 
  (princ) 
) 
;;;(gxl-GetDocumentObject filename) 获取DWG文件的Document 对象 
(defun gxl-GetDocumentObject (filename / acdocs dbx acVer) 
 
  (vlax-map-collection 
    (vla-get-Documents (vlax-get-acad-object)) 
    (function 
      (lambda (doc) 
        (setq acdocs 
               (cons 
                 (cons (strcase (vla-get-fullname doc)) doc) 
                 acdocs 
               ) 
        ) 
      ) 
    ) 
  ) 
 
  (cond 
    ((not (setq filename (findfile filename))) nil) 
    ((cdr (assoc (strcase filename) acdocs))) 
    ((not 
       (vl-catch-all-error-p 
         (vl-catch-all-apply 
           'vla-open 
           (list (setq dbx 
                        (vla-GetInterfaceObject 
                          (vlax-get-acad-object) 
                          (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) 
                            "ObjectDBX.AxDbDocument" 
                            (strcat "ObjectDBX.AxDbDocument." (itoa acVer)) 
                          ) 
                        ) 
                 ) 
                 filename 
           ) 
         ) 
       ) 
     ) 
     dbx 
    ) 
  ) ;_ cond 
) 
;;;gxl-ItemsAll collection )返回集合全部成员表 
(defun gxl-ItemsAll (collection / result) 
  (vl-catch-all-apply 
    (FUNCTION 
      (lambda () 
        (vlax-for item collection (setq result (cons item result))) 
        (reverse result) 
      ) 
    ) 
  ) 
  result 
) 
;;;(gxl-CopyObjects 对象表/图元表/选择集/ENAME/Object 对象宿主 拷贝目标宿主(nil 默认当前空间)) 
;;;(gxl-CopyObjects (ssget) *ACDOCUMENT* (vla-Item (vla-get-Blocks *ACDOCUMENT*) (GXL-DXF (car (GXL-SEL-ENTSEL "选择图块:" '((0 . "insert")))) 2))) 
(defun gxl-CopyObjects ( lst owner dest ) 
  (cond ((= 'List (type lst)) 
         (setq lst (mapcar '(lambda (x) (if (= 'ename (type x)) (vlax-ename->vla-object x) x)) lst)) 
         ) 
        ( (= 'pickset (type lst)) (setq lst (GXL-SEL-SS->VLA lst))) 
        ( (= 'ename (type lst)) (setq lst (list (vlax-ename->vla-object lst)))) 
        ( (= 'vla-object (type lst)) (setq lst (list lst))) 
        ) 
  (if (null dest) (setq dest (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)))) 
  (vla-CopyObjects owner (GXL-NUM-OBJECTVARIANT lst) dest) 
) 
;;;(gxl-num-ObjectVariant vla对象表) 创建vla变体 
(defun gxl-num-ObjectVariant ( lst ) 
  (vlax-make-variant 
    (vlax-safearray-fill 
      (vlax-make-safearray vlax-vbobject 
        (cons 0 (1- (length lst))) 
      ) 
      lst 
    )    
  ) 
) 
 
;;;;;;gxl-sel-ss->vla 选择集转为Vla列表 
(defun gxl-sel-ss->vla ( ss / i l ) 
  (if ss 
    (repeat (setq i (sslength ss)) 
      (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l)) 
    ) 
  ) 
) 
;;; 进程条初始化 (gxl-Sys-Progress-Init 提示 进程总数) 
;;; 进程步进 (gxl-Sys-Progress 进程总数 -1) 
;;; 进程结束 (gxl-Sys-Progress-Done) 
(setq *ProgressID* 0 
      *ProgressPrompt* "" 
      *ProgressBFB* "  0%") 
 
(defun gxl-Sys-Progress-Init (str to) 
    (if *FlagINIT* (alert "上一次进程条没有结束！")) 
    (setq *ProgressID* 0 
          *ProgressTo* to 
          *ProgressPrompt* str 
          *ProgressBFB* 2 
          *FlagINIT* T) 
    ) 
(defun gxl-Sys-Progress-Done () 
    (setq *ProgressID* 0 
          *ProgressTo* nil 
          *ProgressPrompt* "" 
          *ProgressBFB* 2 
          *FlagINIT* nil) 
    (setvar "modemacro" "") 
    ) 
(defun gxl-Sys-Progress        (to i / CS_TEXT MYI bfb corstate LL) 
  (if (not *FlagINIT*) 
    (gxl-Sys-Progress-Init "" 100) 
  ) 
  (if (and *FlagINIT* *ProgressTo*) 
    (setq to *ProgressTo*) 
  ) 
  (setq        cs_text        "████████████████████" 
        LL        (strlen cs_text) 
  ) 
  (if (<= i 0) 
    (setq i               (- *ProgressID* i) 
          *ProgressID* i 
    ) 
    (setq *ProgressID* i) 
  ) 
  (if (> i to) 
    (setq i to) 
  ) 
  (setq        myi (fix (/ (* (strlen cs_text) i) to)) 
        myi (* 2 (/ myi 2)) 
  ) 
  (if (= 0 myi) 
    (setq myi 2) 
  ) 
 
  (setq bfb (fix (* 100 i (/ 1.0 to)))) 
  (if (/= *ProgressBFB* bfb) 
    (progn 
      (setq *ProgressBFB* bfb) 
      (setq 
        cs_text        (substr cs_text 1 myi) 
        cs_text        (strcat cs_text (gxl-Str-Space (- LL myi))) 
      ) 
 
 
      (setq bfb (itoa bfb)) 
      (cond 
        ((= 1 (strlen bfb)) 
         (setq bfb (strcat "  " bfb "% ")) 
        ) 
        ((= 2 (strlen bfb)) (setq bfb (strcat " " bfb "% "))) 
        ((= 3 (strlen bfb)) (setq bfb (strcat bfb "% "))) 
      ) 
      (setvar "modemacro" 
              (strcat *ProgressPrompt* 
                      "已完成" 
                      cs_text 
                      bfb 
              ) 
      ) 
 
    ) 
  ) 
 
 
) 
;;; gxl-Str-Space 制造空格字串 
(defun gxl-Str-Space (n / zf) 
  (if (< n 1) 
   (setq zf "") 
    (progn 
  (setq zf "") 
 
  (repeat n 
    (setq zf (strcat " " zf)) 
    ) 
  ) 
    ) 
  ) 
;; (gxl-file-GetFolder "选择文件夹:") 返回值：字符串，文件夹路径，如果点了cancel, 返回nil 
 
(defun gxl-file-GetFolder (msg / WinShell shFolder path catchit) 
  (setq winshell (vlax-create-object "Shell.Application")) 
  (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1)) 
  (setq 
    catchit (vl-catch-all-apply 
              '(lambda () 
                 (setq shFolder (vlax-get-property shFolder 'self)) 
                 (setq path (vlax-get-property shFolder 'path)) 
               ) 
            ) 
  ) 
  (if (vl-catch-all-error-p catchit) 
    nil 
    path 
  ) 
)

以上为论坛古佬的code，想问下怎么控制插入复制DWG的控制点呢？像insert 一样可以设置控制插入点呢？有大佬有研究吗？

yaojing38 · 发表于 2024-8-29 14:08:10

已解决，先移动到0点，在移动到需要的点！！

kozmosovia · 发表于 2024-8-29 23:28:50

都有DWG列表了，直接遍历一一插入就是了，用DBX多此一举。

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

[经验] ObjectDBX方法批量插入路径下dwg文件 插入点问题

[经验] ObjectDBX方法批量插入路径下dwg文件插入点问题