《2022年2022年几个有用的CAD小程序 .pdf》由会员分享，可在线阅读，更多相关《2022年2022年几个有用的CAD小程序 .pdf（7页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、1.计算所有线段总长度 (加载后只需框选所有线段便可得出这些线段的总长度)(defun c:LL () (setvar cmdecho 1) (setq en ( ssget (list (0 . spline,arc,line,ellipse,LWPOLYLINE) (setq i 0) (setq ll 0) (repeat (sslength en) (setq ss (ssname en i) (setq endata (entget ss) (command lengthen ss ) (setq dd (getvar perimeter) (setq ll (+ dd ll) (s
2、etq i (1+ i) ) (princ 所选线条总长为： )(princ ll)(princ) ) 2.标注所有线段 (加载后只需框选所有线段便可得标注这些线段)(defun c:LLL () (COMMAND UCS ) (setvar cmdecho 1) (SETVAR OSMODE 0) (setq AcadObject (vlax-get-acad-object) AcadDocument (vla-get-ActiveDocument Acadobject) mSpace (vla-get-ModelSpace Acaddocument) ) ;选取需要测量的样条曲线、圆弧、直
3、线、椭圆(setq en ( ssget (list (0 . spline,arc,line,ellipse,LWPOLYLINE) (setq i 0) 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 7 页 - - - - - - - - - ;获取系统参数 textsize (setq shh (getvar textsize) (setq str_hh (strcat n文字高度 : ) (setq hh (getdist str_hh) (while hh (
4、setvar textsize hh) (setq hh nil) ;输入标注文字高度;循环开始(repeat (sslength en) (setq ss (ssname en i) (setq endata (entget ss) (command lengthen ss ) (setq dd (getvar perimeter) (princ (strcat n 长度= (rtos dd 2) ;寻找代表图层的字符串(setq aa (assoc 0 endata) ;获取图层名称(setq aa1 (cdr aa) ;判断线条种类(cond (= aa1 SPLINE) ;如果是 sp
5、line (progn (setq arcObj (VLAX-ENAME-VLA-OBJECT ss) (setq startPnt1 (vla-get-ControlPoints arcObj) (setq p1 (vlax-safearray-list (vlax-variant-value startPnt1) ) (setq x1 (car p1) 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 7 页 - - - - - - - - - (setq y1 (ca
6、dr p1) (setq z1 (caddr p1) (setq pp1 (list x1 y1 z1) (repeat (- (/ (length p1) 3) 1) ;循环，寻找最后一个控制点(setq p1 (cdddr p1) (setq x2 (car p1) (setq y2 (cadr p1) (setq z2 (caddr p1) ) (setq pp2 (list x2 y2 z2) ) ) (= aa1 LWPOLYLINE) ;如果是 LWPOLYLINE (progn (setq arcObj (VLAX-ENAME-VLA-OBJECT ss) (setq start
7、Pnt1 (vla-get-Coordinates arcObj) (setq p1 (vlax-safearray-list (vlax-variant-value startPnt1) ) (setq x1 (car p1) (setq y1 (cadr p1) (setq z1 (caddr p1) (setq pp1 (list x1 y1 z1) (repeat (- (/ (length p1) 3) 1) ;循环，寻找最后一个控制点(setq p1 (cdddr p1) (setq x2 (car p1) (setq y2 (cadr p1) 名师资料总结 - - -精品资料欢迎
8、下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 7 页 - - - - - - - - - (setq z2 (caddr p1) ) (setq pp2 (list x2 y2 z2) ) ) (t ;如果是其他种类线条(progn (setq arcObj (VLAX-ENAME-VLA-OBJECT ss) (setq startPnt1 (vla-get-StartPoint arcObj) ;获取起点(setq endPnt1 (vla-get-EndPoint arcObj) ;获取终点(set
9、q pp1 (vlax-safearray-list (vlax-variant-value startPnt1) ) (setq pp2 (vlax-safearray-list (vlax-variant-value endPnt1) ) ) ) ) (setq x1 (car pp1) (setq y1 (cadr pp1) (setq z1 (caddr pp1) (setq x2 (car pp2) (setq y2 (cadr pp2) (setq z2 (caddr pp2) (setq x (/ (+ x1 x2) 2) (setq y (/ (+ y1 y2) 2) 名师资料
10、总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 4 页，共 7 页 - - - - - - - - - (setq z (/ (+ z1 z2) 2) (setq pt (list x y z) ;取得线段两端的中点(setq ang (angle pp1 pp2) ;获取角度(if ( (* (/ ang pi) 180) 180) (setq ang (+ ang pi) ) (command text j bc pt (* (/ ang pi) 180) (strcat (rtos d
11、d 2) ) (setq i (1+ i) ) (prin1) ) (prompt n 在图中直接写出长度 ) (prin1) 3.连续打断程序(defun c:br1 () (command break pause f pause ) ) 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 7 页 - - - - - - - - - 4.将 CAD 文字导入 Excel表格(defun c:Q2() (setq ffn (getfiled 写出文件 xls 1) (prin
12、c n 选取文字 .) (setq ss ( ssget ) (setq ff (open ffn w) (setq i 0) (repeat (sslength ss) (setq ssn (ssname ss i) (setq ssdata (entget ssn) (setq sstyp (cdr (assoc 0 ssdata) (if (or (= sstyp TEXT) (= sstyp MTEXT) (progn (setq txt (cdr (assoc 1 ssdata) (princ txt ff) (princ n ff) ) ) (setq i (1+ i) ) (cl
13、ose ff) (princ (strcat n 写出文件 : ffn) (prin1) ) 5 删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题 ,今天再贴一次 . 改颜色的 LISP 程序名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 6 页，共 7 页 - - - - - - - - - (defun c:c1()(ssget)(command chprop p c 1 ) (princ) (defun c:c2()(ssget)(command chprop p c 2
14、 ) (princ) (defun c:c3()(ssget)(command chprop p c 3 ) (princ) (defun c:c4()(ssget)(command chprop p c 4 ) (princ) (defun c:c5()(ssget)(command chprop p c 5 ) (princ) (defun c:c6()(ssget)(command chprop p c 6 ) (princ) (defun c:c7()(ssget)(command chprop p c 7 ) (princ) (defun c:c8()(ssget)(command
15、chprop p c 8 ) (princ) 你用 C1 命令就可以将图元改为红色了.其余类似 . 删除红色图元(defun C:D1 (/ m A M) (setq m:err *error* *error* *merr*) (setvar cmdecho 0) (command UNDO G) (prompt 选择图形 ) (setq A (ssget (62 . 1) ) (if (/= A nil)(progn (setq M (sslength A) (command erase A ) (princ n 共删除红色图元 个) ) (command UNDO E) (princ) ) 这样,键入 D1 命令,就可以删除红色的图元了. 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 7 页，共 7 页 - - - - - - - - -