《CAD LISP 程序[精校版本]》由会员分享,可在线阅读,更多相关《CAD LISP 程序[精校版本](8页珍藏版)》请在人人文库网上搜索。
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)(setq i (1+ i)。
2、(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);选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssget (list (0。
3、 . spline,arc,line,ellipse,LWPOLYLINE)(setq i 0);获取系统参数textsize(setq shh (getvar textsize)(setq str_hh (strcat n文字高度 : )(setq hh (getdist str_hh)(while hh(setvar textsize hh)(setq hh nil);输入标注文字高度;循环开始(repeat (sslength en)(setq ss (ssname en i)(setq endata (entget ss)(command lengthen ss )(setq dd (。
4、getvar perimeter)(princ (strcat n长度= (rtos dd 2);寻找代表图层的字符串(setq aa (assoc 0 endata);获取图层名称(setq aa1 (cdr aa);判断线条种类(cond(= aa1 SPLINE);如果是spline(progn(setq arcObj (VLAX-ENAME-VLA-OBJECT ss)(setq startPnt1 (vla-get-ControlPoints arcObj)(setq p1(vlax-safearray-list (vlax-variant-value startPnt1)(setq。
5、 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)(setq z2 (caddr p1)(setq pp2 (list x2 y2 z2)(= aa1 LWPOLYLINE);如果是LWPOLYLINE(progn(setq arcObj (VLAX-ENAME-VLA-OBJECT ss)(setq s。
6、tartPnt1 (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)(setq z2 (caddr p1)(setq pp。
7、2 (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);获取终点(setq pp1(vlax-safearray-list (vlax-variant-value startPnt1)(setqpp2 (vlax-safearray-list (vlax-variant-value endPnt1)(setq x1 (car pp。
8、1)(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)(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 textjbcpt(* (/ ang pi) 180)(strcat (rtos dd 2)(setq i (1+ i)(prin1)(prompt n 个)(command UNDO E)(princ)这样,键入 D1 命令,就可以删除红色的图元了.8优异品。