求批量插入图纸的程序
<p>1.谁有批量插入图纸的程序，只要能把一个目录下的多张图纸，作为图块依次插入新图中，图块名用原文件名。</p><p>2.我不需要佷好的排版，不需要旋转，各个块能铺开不要叠成一堆就行。</p><p>3.另外我还需要反向操作的程序，即把一张图的各个图块依次输出，图块名做文件名。</p><p></p><p>以上这个东西的用途是，解密。</p> <p>不明白的是这样一个程序和解密有什么关联<br/><br/><br/><br/><br/></p><p>归档文件合并.lsp</p><p>1。需要doslib函数库支持</p><p>2。需要手动建立c:\QGY_temp文件夹</p><p>(defun c:insdwgs()<br/> (princ "\n 归档文件合并 edit by yuuboo \n")<br/> (setvar "cmdecho" 0)<br/> (setq dwgpath (dos_getdir "选择要操作的文件夹:" (if dwgpath dwgpath "F:\\work归档") "归档文件后处理"))<br/> (if dwgpath<br/> (progn<br/> (setq fff (dos_dir (strcat dwgpath "*.dwg") 1))<br/> (setq ini (open "c:\\QGY_temp\\目录列表.ini" "w"))<br/> (foreach x fff<br/> (write-line (strcat dwgpath x) ini)<br/> )<br/> (setq ini (open "c:\\QGY_temp\\目录列表.ini" "r"))<br/> (insdwgs_main)<br/> )<br/> )<br/>(princ)<br/>)</p><p>(defun ax:2DPoint (pt)<br/> (vl-load-com)<br/> (vlax-make-variant<br/> (vlax-safearray-fill<br/> (vlax-make-safearray vlax-vbdouble '(0 . 1))<br/> (list (car pt) (cadr pt))<br/> )<br/> )<br/>)</p><p>(defun ax:GetBoundingBox (ent / ll ur)<br/> (vl-load-com)<br/> (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)<br/> (mapcar 'vlax-safearray->list (list ll ur))<br/>)</p><p>(defun insdwgs_main()<br/> (setq ss-ss '())<br/> (while (and (setq newdwg (read-line ini)) (/= newdwg ""))<br/> (command "insert" newdwg "non" "0,0" 1 1 0)<br/> (setq dwg_block (entlast))<br/> (setq ss (ssadd))<br/> (setq ss (ssadd (entlast) ss))<br/> (setq box (ax:getboundingbox dwg_block))<br/> (setq p1 (car box))<br/> (setq p2 (cadr box))<br/> (setq pp (polar (list (car p2)(cadr p1)) (* pi 0.25) 20000))<br/> ;; (command "text" "non" pp 20000 0 (substr (nth 2 (dos_strtokens (nth 2 (dos_splitpath newdwg)) "-")) 3))<br/> (command "text" "non" pp 20000 0 newdwg);;我的程序是针对工程图纸合并所写，所以20000的字高对一般的应用可能大了，自己改吧<br/> (setq ss (ssadd (entlast) ss))<br/> (setq diss (- (cadr p2)(cadr p1) -10000))<br/> (setq ss-ss (cons (list (list (car p1)(cadr p2)) diss ss) ss-ss))</p><p> )<br/> (setq po '(0 0))<br/> (setq ss-ss (reverse ss-ss))<br/> (foreach x ss-ss<br/> (setq aa (nth 0 x))<br/> (setq bb (nth 1 x))<br/> (setq cc (nth 2 x))<br/> (command "move" cc "" "non" aa "non" po)<br/> (setq po (polar po (* pi -0.5) bb))<br/> )<br/> (command "zoom" "e")<br/> (close ini)<br/> <br/> (setq filename (getfiled "保存文件" dwgpath "dwg" 1))<br/> (if (findfile filename)<br/> (command "save" filename "y")<br/> (command "save" filename)<br/> )<br/> (setvar "filedia" 1)</p><p>(princ)<br/>)</p> <p>输出所有块</p><p>(defun c:wab()<br/> (setq bk_list '())<br/> (setq aa (tblnext "block" T))<br/> (if aa (setq aa (cdr (assoc 2 aa))))<br/> (if aa (setq bk_list (cons aa bk_list)))<br/> (while (setq aa (tblnext "block"))<br/> (setq aa (cdr (assoc 2 aa)))<br/> (setq bk_list (cons aa bk_list))<br/> )<br/> (prin1 bk_list)<br/> (foreach x bk_list<br/> (if (findfile (strcat "d:\\eeeeeeeeee\\" x ".dwg"))<br/> (command "wblock" (strcat "d:\\eeeeeeeeee\\" x) "y" "=")<br/> (command "wblock" (strcat "d:\\eeeeeeeeee\\" x) "=")<br/> )<br/> )<br/> (princ "\n+++")<br/>(princ)<br/>)</p><p></p> <p>谢谢了，</p><p> </p>
<p>和解密的关系有：</p>
<p>1.假如需要偷偷解密，当然要合并一下再搞。</p>
<p>2.有些加密的cad可以通过word的导入导出解密，当然没人想一次只搞一张。</p> 学习了，不过不知道doslib函数库是什么呀？ 这就是个批量插入块的程序，其实最好按照坐标值依次递增的顺序插入，这样就不会乱。上某宝搜搜就行了。
页:
[1]