感激各位热心朋友的大力支持`
本帖最后由 Gu_xl 于 2011-9-9 11:02 编辑
xiaxiang 发表于 2011-9-9 09:13 http://bbs.mjtd.com/static/image/common/back.gif
学习gu_xl版主。。。
只是不知道在用法上有没有什么讲究？
我的报错
是有点错误，谢谢提醒，修改如下！
(defun c:BatchInsert (/ path)
(
(lambda
(path files / dbxdoc dbxModelSpace all t1)
(GXL-SYS-PROGRESS-INIT "" (length files))
(foreach dwg files
(GXL-SYS-PROGRESS (length files) -1)
(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
)
)
)
objectdbx方法插图，对于单独dwg文件内容较少，文件夹下文件多，速度还是比较快，但对于单独dwg文件内容较多的图，使用objectdbx方法插图相比insert方法插图，就没什么优势了,反而可能比较慢!大家可以自己测试下！把上述代码：(foreach dwg files...) 换成：
(foreach dwg files
(GXL-SYS-PROGRESS (length files) -1)
(command "insert" (strcat "*" path "\\" dwg) '(0 0 0) 1 0)
)
本帖最后由 xiaoyingzi 于 2011-9-9 13:47 编辑
不过都插在一起，而且是炸开的，3000多张，就悲剧了
发几个收集的源码：
;;;老虎空间 超越极至 2009.11.20
(defun c:insert-alldwgfil ( / dwgfiles item path)
(vl-load-com)
(setq path (getfiled "选择批量插入图形路径中的一个图形文件" "" "dwg" 16))
(setq path (substr path 1 (1+ (vl-string-position (ascii "\\") path nil t))))
(setq dwgfiles (vl-directory-files path "*.dwg" 1))
(foreach item dwgfiles
(vl-cmdf "insert" (vl-list->string (subst
47
92
(vl-string->list (strcat path item))
)
) (getpoint) "" "" ""
)
)
(princ (strcat "本次操作共计插入:" (itoa (length dwgfiles)) "个DWG文件."))
(princ)
)
;;插图到一起,来源吴所不及的插计算书源程序,自己做了修改,可多选文件，自动排列插入
(defun c:batchins ()
(setq oldosmode (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(if (not (tblsearch "layer" "PUB_TITLE"))
(command "layer" "m" "PUB_TITLE" "s" "PUB_TITLE" "c" "4" "PUB_TITLE" "")
(command "layer" "s" "PUB_TITLE" ""))
(setq filelist (ayGetMultFiles "选择多个DWG文件" "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" "") )
(setq filedir (car filelist))
(setq file-list (cdr filelist))
(setq pt-start (getpoint))
;|
(initget "Y N_Yes No")
(setq changepos (getkword "\n是否炸开插入图纸?<Y>:"))
(if (null changepos) (setq changepos "y"))
|;
(setq paper-dist 10000)
(if file-list (setq max-distx (my_insert pt-start file-list 1)
pt-start (polar pt-start 0 (+ paper-dist max-distx))
)
)
(princ"\n清理插入图纸临时生成的块:\n")
(command "purge" "b" "*" "n")
;(vla-purgeall (vla-get-activedocument(vlax-get-acad-object)))
(command "zoom" "e" "zoom" "0.8x")
(setvar "osmode" oldosmode)
(princ)
)
;;-------------------------------------------------------------------------------------------------------------
;; 明经通道 参照xiaomu写于2005-10-12，按wangph意见，ayunger修改于2008-11-07
;; Windows多文件选择(适用于CADR15以上) 函数
;; 说明: 本函数使用MsComDlg.Commondialog对象(Comdlg.OCX)
;; 调用: (ayGetMultFiles "多选文件" "图形文件(*.dwg)|*.dwg|所有(*.*)|*.*" "")
;; 返回: ("C:\\DWG" "1.dwg" "2.dwg" "3.Dwg")
(if (/= (vl-registry-read "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905")
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj")
(vl-registry-write "HKEY_CLASSES_ROOT\\Licenses\\4D553650-6ABE-11cf-8ADB-00AA00C00905" ""
"gfjmrfkfifkmkfffrlmmgmhmnlulkmfmqkqj")
)
(defun ayGetMultFiles (strTitle strFilter strInitDir / Maxfiles Flags WinDlg mFiles Catchit)
(vl-load-com)
(setq WinDlg (vlax-create-object "MSComDlg.CommonDialog"))
(if (not WinDlg)
(progn;then
(princ "\n【错误】系统中未安装通用控件Comdlg.OCX, 请安装后再运行!")
(setq mFiles nil)
);end_progn then
(progn;else
(setq Maxfiles 32767)
(setq Flags (+ 4 512 524288 1048576 1024))
(vlax-put-property WinDlg 'CancelError :vlax-true)
(vlax-put-property WinDlg 'MaxFileSize Maxfiles)
(vlax-put-property WinDlg 'Flags Flags)
(vlax-put-property WinDlg 'DialogTitle strTitle)
(vlax-put-property WinDlg 'Filter strFilter)
(vlax-put-property WinDlg 'InitDir strInitDir)
(setq Catchit nil)
(setq Catchit (vl-catch-all-apply '(lambda ()
(vlax-invoke-method WinDlg 'ShowOpen)
(setq mFiles (vlax-get WinDlg 'Filename)))))
(vlax-release-object WinDlg)
(if (not (vl-catch-all-error-p Catchit));处理"取消"错误.
(ayFSTR->LST mFiles)
nil;else
);end_if
);end_progn
);end_if
);end_defun
;; 明经通道 参照xiaomu 按wangph意见 ayunger修改
;; 处理Windows多文件选择返回值 函数
;; 说明: 将"C:\\DWG1\0001.dwg\0002.dwg" 处理成:
;; ("C:\\DWG1" "1.dwg" "2.dwg" "3.dwg") 表形式.
(Defun ayFSTR->LST (xMFileStr / mFileList k)
(if (= xMFileStr "")
(setq mFileList nil);then
(progn
(if (vl-string-position (ascii "\000") xMFileStr)
(progn
(while (vl-string-position (ascii "\000") xMFileStr)
(setq k (vl-string-position (ascii "\000") xMFileStr))
(setq mFileList (append mFileList (list (substr xMFileStr 1 k))))
(setq xMFileStr (substr xMFileStr (+ k 2) (- (strlen xMFileStr) k 1)))
);end_while
(setq mFileList (append mFileList (list (vl-string-left-trim "\\" xMFileStr))))
);end_progn then
(progn
(setq mFileList (vl-filename-directory xMFileStr))
(setq mFileList (list mFileList (vl-string-left-trim "\\" (vl-string-subst "" mFileList xMFileStr))))
);end_progn else
);end_if
mFileList
);end_progn
);end_if
);end_defun
(defun str-to-num (str1)
(setq n 0)
(setq s1 "")
(while
(if (and (/= "" (setq cha (substr str1 (setq n (1+ n)) 1))))
(if (wcmatch cha "#")
(setq s1 (strcat s1 cha))
(if (/= s1 "")
nil
t
)
)
nil
)
)
(setq num1 (atoi s1))
)
(defun my_insert (pt file-list scale)
(setq diet 0)
(setq x (car pt)
y (cadr pt)
)
(setq max-distx 0)
(setq
file-list (vl-sort
file-list
(function
(lambda (str1 str2)
(< (str-to-num str1)
(str-to-num str2)
)
)
) ;_lambda
) ;_function
)
(foreach filename file-list
(progn
(command
"_insert"
(strcat filedir "\\" filename)
(list x y 0)
scale
scale
0
)
(progn
(setq newen1 (entlast))
(setq obj (vlax-ename->vla-object newen1))
(vla-getboundingbox obj 'll 'ur)
(setq pt1 (vlax-safearray->list ll))
(setq pt2 (vlax-safearray->list ur))
(vl-cmdf ".rectangle" (polar pt1 -3.14 1000) pt2)
(setq newen2 (entlast))
(setq obj (vlax-ename->vla-object newen2))
(vla-put-color obj 8)
;|(entmake (list
(cons 0 "TEXT")
(cons 1 filename) ;文字内容
(cons 40 700.0) ;文字高度
(cons 41 0.7) ;文字宽高比
(cons 10 (polar pt1 (* 0.5 pi) 1000)) ;文字写入点
(cons 50 0) ;文字角度
(cons 8 "0") ;文字图层
(cons 7 "STANDARD") ;文字样式
)
)|;
;(setq newen3 (entlast))
(command "_.move" newen1 newen2 "" pt1 (list x y 0))
;(if (or (= "y" changepos) (= "Y" changepos) (= "yes" changepos))
(command "explode" newen1)
;)
(setq distx (- (car pt2) (car pt1)))
(setq disty (- (cadr pt2) (cadr pt1)))
(setq max-distx (max distx max-distx))
(setq y (+ disty y paper-dist)) ;_增加图的y坐标.
;(command "scale" newen "" (midpt pt1 pt2) 1.02);_外框放大.
)
(princ (strcat "\n已插入" filedir "\\" filename))
)
)
max-distx
)
Gu_xl 发表于 2011-9-9 11:30 static/image/common/back.gif
objectdbx方法插图，对于单独dwg文件内容较少，文件夹下文件多，速度还是比较快，但对于单独dwg文件内容较多 ...
我觉得最有用的是这个函数！学习了。
;; (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
)
)
图形错误不知道谁有没有什么办法不让插入呢？我那个插不了，应该是图形报错的原因
Gu_xl 发表于 2011-9-8 20:43 static/image/common/back.gif
去我的博客看看，这有答案！
http://gyh060707.blog.sohu.com/
果然不同凡响，进门的感觉都不一样，谢谢
感谢分享,学习了!
本帖最后由 qfkxc 于 2011-9-17 19:48 编辑
运行程序后进程一直为3％，不知何故
Error:can,tlocateobjectdbxlibrary (axdb.dll)是什么原因
、
xiaoyingzi 发表于 2011-9-9 13:40 static/image/common/back.gif
不过都插在一起，而且是炸开的，3000多张，就悲剧了
发几个收集的源码：
;;;老虎空间 超越极至 2009.11.2 ...
对不炸开批量插图块比较感兴趣，看了上面的程序，好像只有一个让选择炸开否，可运行后发现，; 错误: no function definition: AYGETMULTFILES。 不知程序中的AYGETMULTFILES 这个函数如何定义，望高手帮忙解决，谢谢。