lisp批量生成轴线_求批量插入图纸的程序 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...

不明白的是这样一个程序和解密有什么关联

归档文件合并.lsp

1。需要doslib函数库支持

2。需要手动建立c:\QGY_temp文件夹

(defun c:insdwgs()

(princ "\n 归档文件合并   edit by yuuboo \n")

(setvar "cmdecho" 0)

(setq dwgpath (dos_getdir "选择要操作的文件夹:" (if dwgpath dwgpath "F:\\work归档") "归档文件后处理"))

(if dwgpath

(progn

(setq fff (dos_dir (strcat dwgpath "*.dwg") 1))

(setq ini (open "c:\\QGY_temp\\目录列表.ini" "w"))

(foreach x fff

(write-line (strcat dwgpath x) ini)

)

(setq ini (open "c:\\QGY_temp\\目录列表.ini" "r"))

(insdwgs_main)

)

)

(princ)

)

(defun ax:2DPoint (pt)

(vl-load-com)

(vlax-make-variant

(vlax-safearray-fill

(vlax-make-safearray vlax-vbdouble '(0 . 1))

(list (car pt) (cadr pt))

)

)

)

(defun ax:GetBoundingBox (ent / ll ur)

(vl-load-com)

(vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)

(mapcar 'vlax-safearray->list (list ll ur))

)

(defun insdwgs_main()

(setq ss-ss '())

(while (and (setq newdwg (read-line ini)) (/= newdwg ""))

(command "insert" newdwg "non" "0,0" 1 1 0)

(setq dwg_block (entlast))

(setq ss (ssadd))

(setq ss (ssadd (entlast) ss))

(setq box (ax:getboundingbox dwg_block))

(setq p1 (car box))

(setq p2 (cadr box))

(setq pp (polar (list (car p2)(cadr p1)) (* pi 0.25) 20000))

;; (command "text" "non" pp 20000 0 (substr (nth 2 (dos_strtokens (nth 2 (dos_splitpath newdwg)) "-")) 3))

(command "text" "non" pp 20000 0 newdwg);;我的程序是针对工程图纸合并所写，所以20000的字高对一般的应用可能大了，自己改吧

(setq ss (ssadd (entlast) ss))

(setq diss (- (cadr p2)(cadr p1) -10000))

(setq ss-ss (cons (list (list (car p1)(cadr p2)) diss ss) ss-ss))

)

(setq po '(0 0))

(setq ss-ss (reverse ss-ss))

(foreach x ss-ss

(setq aa (nth 0 x))

(setq bb (nth 1 x))

(setq cc (nth 2 x))

(command "move" cc "" "non" aa "non" po)

(setq po (polar po (* pi -0.5) bb))

)

(command "zoom" "e")

(close ini)

(setq filename (getfiled "保存文件" dwgpath "dwg" 1))

(if (findfile filename)

(command "save" filename "y")

(command "save" filename)

)

(setvar "filedia" 1)

(princ)

)