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

米兰达薇薇2899

;;;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
  )
)


该贴已经同步到 米兰达薇薇2899的微博

鱼与熊掌

你在干嘛 搬运工吗 亲,~

lucas_3333

还真是搬运工，固版的代码

米兰达薇薇2899

不好意思，自己搜集的，忘了是固版的了

zzyong00

转载请注明出处。。。