求CAD图纸合并的LISP程序

teykmcqh

谁有把多张CAD图纸合并到一张图纸文件的LISP程序吗？最好能按文件名顺序排列在一张图纸上，先表感谢！
因工作原因，经常需要把多张相同格式的图纸合并到一张图纸上，便于一起修改和打印，一个个拖拉或插入较麻烦。但本人只会编写简单一些的LISP应用程序，在网站搜寻一下，也没找到合适的，哪位同仁有的话，可以共享一下吗？

lvhao0204

源代码，我不会用，你们看看
(defun c:mlpt (/ distx disty ent file files maxpoint minpoint path pmax

          pmin pt1 pt2 sca

       )


(command ".UNDO" "BE")

  (setq sca (getvar "dimscale"))

  (setq cmd (getvar "cmdecho"))

  (setq oldos (getvar "OSMODE"))

  (setvar "cmdecho" 0)

  (setvar "OSMODE" 0)

   (getstring "\n本程序将合并指定目录内的所有文件，执行速度较慢，请耐心等待。回车继续...")

  (setq pt2 (getpoint "\n请选择插入点:"))

  (setq path (browseforfolder "请选择要合并图纸的目录"))

  (if (/= path nil)

    (progn

      (if (/= (substr path (strlen path) 1) "\\")

  (setq path (strcat path "\\"))

      )

      (setq files (vl-directory-files path "*.dwg" 0))

      (while files

  (setq file (strcat path (car files)));;;  (princ file)

;;;  (princ "\n")

  (command "-INSERT" file pt2 1 1 0)

  (setq ent (entlast));;;  (princ ent)

  (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)

  (setq pmax (vlax-safearray->list maxpoint)

        pmin (vlax-safearray->list minpoint)

  )

  (setq distx (- (car pmax) (car pmin)))

  (setq disty (- (cadr pmax) (cadr pmin)))

  (setq pt1 (list (car pmax) (cadr pmin)))

  (command "move" ent "" pt1 pt2)

  (command "EXPLODE" ent "")

  (setq pt2 (polar pt2 (/ pi 2) (+ disty (* 40 sca))))

  (setq files (cdr files))

      )

    )

  )

  (setvar "OSMODE" oldos)

  (setvar "CMDECHO" cmd)

  (command ".UNDO" "E")

  (princ)

)


;;; [功能] 以目录树方式浏览文件夹并返回路径

;;; [参数] msg---提示信息

;;; [返回] 文件夹路径，如果选择了cancel, 返回nil

;;; [测试] (browseforfolder "选择文件保存路径: ")

(defun browseforfolder (msg / shfolder path catchit)

  (setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")

         'browseforfolder

         (vlax-get-property

       (vlax-get-acad-object)

       'hwnd

         ) msg 1

   )

catchit (vl-catch-all-apply '(lambda ()

           (setq shfolder

          (vlax-get-property shfolder

        'self

          )

          path

          (vlax-get-property shfolder

        'path

          )

           )

         )

  )

  )

  (if (vl-catch-all-error-p catchit)

    nil

    path

  )

)

longer1000

我也想要，楼主现在解决没有哦

xiaxiang

longer1000 发表于 2012-12-20 16:01
我也想要，楼主现在解决没有哦

发个批量插图程序[2012.12.20]
http://bbs.mjtd.com/thread-99685-1-1.html

ZZWQ2002

学习学习  谢谢分享