AutoCAD二次开发(autolisp语言)
♦用autolisp二次开发实现CAD模型（非布局）出图的整套高效方案：
模型相对于布局出图最大的劣势，可能就是标注样式大小的问题，布局出图可以完美实现固定大小的标注样式，但是缺点也很明显，布局窗口中的内容与标注的关联性不好，而且想要像在模型视图里那样去模拟装配也是困难。
我个人还是倾向于用模型来出图的，配合二次开发的代码，可以实现图纸标注全局比例的切换以解决模型出图的短板，这个程序其实比较简单，后面还有批量打印、批量编号、批量转pdf、批量生成BOM的程序，配合使用，会让模型出图变得更加舒适。
;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:dn(/ l f ln fn p1 p2)
(command "line" pause pause "")
(setq p1 (cdr (assoc 10 (entget (entlast)))))
(setq p2 (cdr (assoc 11 (entget (entlast)))))
(setq l (distance p1 p2))
(if (< (cadr p1) (cadr p2))
(setq p2 p1)
)
(command "erase" (entlast) "")
(setq f (getstring "请输入纸型，A4 or A3"))
(if (= f "")
(setq f "A3")
)
(if (= f "4")
(setq f "A4")
)
(if (= f "3")
(setq f "A3")
)
(setq f (strcase f))
(cond ((= f "A4") (setq ln (/ l 210)))
;;; ((= f "A3") (setq ln (* (/ l 297) (/ 2.3 3)))) 此字段加入了再缩小的参数(/ 2.3 3)
((= f "A3") (setq ln (* (/ l 297) 1)))
(t (prompt "输入格式错误，退出命令") (quit))
)
(command "dimscale" (rtos ln 2 1))
(setq fn (rtos ln 2 1))
(setq fn (strcat "ZGB-" fn))
(command "-dimstyle" "s" fn "" "");;这里用到两个引号来防止特殊情况下，命令有增加。
;;; (command "text" "j" "tl" p2 (* 3 (/ ln (/ 2.3 3))) 0 (strcat "标注样式为" fn))
(setq pa (polar p2 (* pi 1.5) (* ln 4)))
(setq pa5 (polar p2 (* pi 1.5) (* ln 10)))
(cond ((= f "A4")
(progn
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq zigao2.5 (rtos (* 2.5 (/ ln 1)) 2 4))
(setq zigao3.5 (rtos (* 3.5 (/ ln 1)) 2 4))
(setq zigao5 (rtos (* 5 (/ ln 1)) 2 4))
(command "text" "j" "tl" p2 (* 2.5 ln ) 0 (strcat "2.5字高标注样式为" fn " 实际字高：" zigao2.5))
(command "text" "j" "tl" pa (* 3.5 ln ) 0 (strcat "3.5字高标注样式为" fn " 实际字高：" zigao3.5))
(command "text" "j" "tl" pa5 (* 5 (/ ln 1)) 0 (strcat "5字高标注样式为" fn " 实际字高：" zigao5))
(setvar "osmode" os)
)
)
((= f "A3")
(progn
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq zigao2.5 (rtos (* 2.5 (/ ln 1)) 2 4))
(setq zigao3.5 (rtos (* 3.5 (/ ln 1)) 2 4))
(setq zigao5 (rtos (* 5 (/ ln 1)) 2 4))
(command "text" "j" "tl" p2 (* 2.5 (/ ln 1)) 0 (strcat "2.5字高标注样式为" fn " 实际字高：" zigao2.5))
(command "text" "j" "tl" pa (* 3.5 (/ ln 1)) 0 (strcat "3.5字高标注样式为" fn " 实际字高：" zigao3.5))
(command "text" "j" "tl" pa5 (* 3.5 (/ ln 1)) 0 (strcat "5字高标注样式为" fn " 实际字高：" zigao5))
(setvar "osmode" os)
)
)
)
(prompt (strcat "已经生成标注样式" fn "\n 采用全局比例为：" (rtos ln 2 4) "\n"))
(command "-dimstyle" "r" (strcat fn))
(prin1)
)
;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:dnt(/ l f ln fn p1 p2)
(command "line" pause pause "")
(setq p1 (cdr (assoc 10 (entget (entlast)))))
(setq p2 (cdr (assoc 11 (entget (entlast)))))
(setq l (distance p1 p2))
(if (< (cadr p1) (cadr p2))
(setq p2 p1)
)
(command "erase" (entlast) "")
(setq f (getstring "请输入纸型，A4 or A3"))
(if (= f "")
(setq f "A3")
)
(if (= f "4")
(setq f "A4")
)
(setq f (strcase f))
(cond ((= f "A4") (setq ln (/ l 210)))
;;; ((= f "A3") (setq ln (* (/ l 297) (/ 2.3 3)))) 此字段加入了再缩小的参数(/ 2.3 3)
((= f "A3") (setq ln (* (/ l 297) 1)))
(t (prompt "输入格式错误，退出命令") (quit))
)
(command "dimscale" (rtos ln 2 1))
(setq fn (rtos ln 2 1))
(setq fn (strcat "ZGB-" fn))
;;; (command "text" "j" "tl" p2 (* 3 (/ ln (/ 2.3 3))) 0 (strcat "标注样式为" fn))
(setq pa (polar p2 (* pi 1.5) (* ln 4)))
(setq pa5 (polar p2 (* pi 1.5) (* ln 10)))
(prompt (strcat "\n 采用全局比例为：" (rtos ln 2 4) "\n"))
(prin1)
)
;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:dg(/ ds)
(setq en1 (entsel))
(setq en1_data (entget (car en1)))
(setq ds (cdr (assoc 3 en1_data)))
(command "-dimstyle" "r" ds)
(prin1)
)
)
♦零散的小工具：
这里是一些没有归类的小工具，有的是针对一些命令进行了改进，有的是另外开发的。;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:Tc()
(setq wh(ssget))
(setq wh (ssget "P" '((-4 . "<OR") (0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))
(setq fi (ssname wh 1))
(setq b1 '(()))
(setq r 1)
(setq n 0)
(setq n2 1)
(setq b1 '(()))
(repeat (sslength wh)
(setq en(ssname wh n))
(setq n (+ n 1))
(setq e(entget en))
(setq txtd (cdr(assoc 1 e)));txtd文本内容
(setq txtd (replace txtd))
(setq info (list n (car(cdr(cdr(assoc 10 e)))) txtd) )
(setq b1 (cons info b1))
);repeat
(setq nr (- n 1))
(repeat (- n 1)
(setq nn 0)
(repeat nr
(setq nn (+ nn 1))
(setq nn1 (+ nn 1))
(setq testa (car(cdr(assoc nn b1))))
(setq testb (car(cdr(assoc nn1 b1))))
(if (< testa testb)
(progn
(setq ntesta (cons nn1 (cdr(assoc nn b1))))
(setq otesta (assoc nn b1))
(setq ntestb (cons nn (cdr(assoc nn1 b1))))
(setq otestb (assoc nn1 b1))
(setq b1(subst ntesta otesta b1))
(setq b1(subst ntestb otestb b1))
);progn
);if
);repeat1
(setq nr (- nr 1))
)
(setq np 0)
(setq bf nil)
(repeat n
(setq np (+ np 1))
(setq wid (car(cdr(cdr(assoc np b1)))))
(if (= bf nil)
(setq bf (strcat "\n" wid))
(setq bf (strcat bf "\n" wid))
)
)
(SET-CLIP-STRING bf)
(prin1)
)
(defun SET-CLIP-STRING (STR / HTML RESULT) ;将内容复制到剪贴板上的子函数，用法就是(SET-CLIP-STRING b)，输出b。这部分非原创，很久以前在网站查到的代码，如果原作者需要注明出处，请于本人联系。
(and (= (type STR) 'STR)
(setq HTML (vlax-create-object "htmlfile"))
(setq RESULT (vlax-invoke
(vlax-get (vlax-get HTML 'PARENTWINDOW)
'CLIPBOARDDATA
)
'SETDATA
"Text"
STR
)
)
(vlax-release-object HTML)
)
)
;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:lg()
(setq en1 (entsel))
(setq en1_data (entget (car en1)))
(setq a (assoc 8 en1_data))
(setq a (cdr a))
(command "-layer" "s" a "")
(prin1)
)
;;;双击此处展开，新建一个txt文件，将这段代码复制到其中，然后保存，将后缀名改为.lsp，然后在AutoCAD中加载。有问题，请联系dzoneste@hotmail.com
(defun c:erd(/ r i j)
(setq tukuang (ssget))
(setq tk (ssget "P" '((-4 . "<OR") (0 . "DIMENSION")(0 . "LEADER")(0 . "MULTILEADER")(0 . "TEXT")(-4 . "OR>"))))
(command "erase" tk "")
(prin1)
)