ObjectDBX方法批量插入路径下dwg文件 插入点问题
;;;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 一样可以设置控制插入点呢？有大佬有研究吗？
已解决，先移动到0点 ，在移动到需要的点！！:lol 都有DWG列表了，直接遍历一一插入就是了，用DBX多此一举。
页:
[1]