求CAD图纸合并的LISP程序
谁有把多张CAD图纸合并到一张图纸文件的LISP程序吗？最好能按文件名顺序排列在一张图纸上，先表感谢！因工作原因，经常需要把多张相同格式的图纸合并到一张图纸上，便于一起修改和打印，一个个拖拉或插入较麻烦。但本人只会编写简单一些的LISP应用程序，在网站搜寻一下，也没找到合适的，哪位同仁有的话，可以共享一下吗？
源代码，我不会用，你们看看
(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 发表于 2012-12-20 16:01 static/image/common/back.gif
我也想要，楼主现在解决没有哦
发个批量插图程序
http://bbs.mjtd.com/thread-99685-1-1.html 学习学习谢谢分享
页:
[1]