批量插图

vexation

感激各位热心朋友的大力支持`

Gu_xl

xiaxiang 发表于 2011-9-9 09:13
学习gu_xl版主。。。
只是不知道在用法上有没有什么讲究？
我的报错

是有点错误，谢谢提醒，修改如下！

1. (defun c:BatchInsert (/ path)
   
2.   (
   
3.    (lambda
   
4.      (path files / dbxdoc dbxModelSpace all t1)
   
5.             (GXL-SYS-PROGRESS-INIT "" (length files))
   
6.       (foreach dwg files
   
7.         (GXL-SYS-PROGRESS (length files) -1)
   
8.         (setq dbxdoc (gxl-GetDocumentObject (strcat path "\\" dwg)))
   
9.         (setq dbxModelSpace (vla-get-ModelSpace dbxdoc))
   
10.         (setq all (GXL-ITEMSALL dbxModelSpace))
    
11.         (gxl-CopyObjects all dbxdoc nil)
    
12.       )
    
13.       (gxl-Sys-Progress-Done)
    
14.          )
    
15.     (setq path (GXL-FILE-GETFOLDER "选取文件夹"))
    
16.     (
    
17.      (lambda (path)
    
18.        (if path
    
19.          (VL-DIRECTORY-FILES path "*.dwg" 1)
    
20.        )
    
21.      )
    
22.       path
    
23.     )
    
24.   )
    
25. )
    

(defun c:BatchInsert (/ path)<br />   (<br />    (lambda<br />      (path files / dbxdoc dbxModelSpace all t1)<br />             (GXL-SYS-PROGRESS-INIT "" (length files))<br />       (foreach dwg files<br />         (GXL-SYS-PROGRESS (length files) -1)<br />         (setq dbxdoc (gxl-GetDocumentObject (strcat path "\\" dwg)))<br />         (setq dbxModelSpace (vla-get-ModelSpace dbxdoc))<br />         (setq all (GXL-ITEMSALL dbxModelSpace))<br />         (gxl-CopyObjects all dbxdoc nil)<br />       ) <br />       (gxl-Sys-Progress-Done)<br />          ) <br />     (setq path (GXL-FILE-GETFOLDER "选取文件夹"))<br />     (<br />      (lambda (path)<br />        (if path<br />          (VL-DIRECTORY-FILES path "*.dwg" 1)<br />        ) <br />      ) <br />       path<br />     )<br />   )<br /> )<br />

Gu_xl

objectdbx方法插图，对于单独dwg文件内容较少，文件夹下文件多，速度还是比较快，但对于单独dwg文件内容较多的图，使用objectdbx方法插图相比insert方法插图，就没什么优势了,反而可能比较慢!大家可以自己测试下！把上述代码：(foreach dwg files...) 换成：

1. (foreach dwg files
   
2.         (GXL-SYS-PROGRESS (length files) -1)
   
3.         (command "insert" (strcat "*" path "\\" dwg) '(0 0 0) 1 0)
   
4.         )
   

(foreach dwg files<br />         (GXL-SYS-PROGRESS (length files) -1)<br />         (command "insert" (strcat "*" path "\\" dwg) '(0 0 0) 1 0)<br />         )<br />

xiaoyingzi

不过都插在一起，而且是炸开的，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/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
)

mandala

Gu_xl 发表于 2011-9-9 11:30
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
  )
)

vexation

图形错误不知道谁有没有什么办法不让插入呢？我那个插不了，应该是图形报错的原因

teykmcqh

Gu_xl 发表于 2011-9-8 20:43
去我的博客看看，这有答案！
http://gyh060707.blog.sohu.com/

果然不同凡响，进门的感觉都不一样，谢谢

yoyoho

感谢分享,学习了!

qfkxc

运行程序后进程一直为3％，不知何故
Error:can,t  locate  objectdbx  library (axdb.dll)是什么原因
、

xuexicad1960

xiaoyingzi 发表于 2011-9-9 13:40
不过都插在一起，而且是炸开的，3000多张，就悲剧了
发几个收集的源码：
;;;老虎空间 超越极至 2009.11.2 ...

对不炸开批量插图块比较感兴趣，看了上面的程序，好像只有一个让选择炸开否，可运行后发现，; 错误: no function definition: AYGETMULTFILES。 不知程序中的  AYGETMULTFILES 这个函数如何定义，望高手帮忙解决，谢谢。