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)) ) (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 . "spline,arc,line,ellipse,LWPOLYLINE")))) (setq i 0) ;;获取系统参数textsize (setq shh (getvar"textsize")) (setq str_hh(strcat "\n文字高度 <" (rtos shh2) ">: ")) (setq hh(getdist str_hh)) (while hh (setvar"textsize" hh) (setq hhnil)) ;;输入标注文字高度 ;;循环开始 (repeat(sslength en) (setq ss(ssname en i)) (setq endata(entget ss)) (command"lengthen" ss "") (setq dd(getvar "perimeter")) (princ(strcat "\n长度=" (rtos dd2))) ;;寻找代表图层的字符串 (setq aa(assoc 0 endata)) ;;获取图层名称 (setq aa1(cdr aa)) ;;判断线条种类 (cond ((= aa1 "SPLINE") ;;如果是spline (progn (setq arcObj(VLAX-ENAME->VLA-OBJECT ss)) (setqstartPnt1 (vla-get-ControlPoints arcObj)) (setq p1 (vlax-safearray->list(vlax-variant-value startPnt1)) ) (setq x1 (carp1)) (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 (carp1)) (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)) (setqstartPnt1 (vla-get-Coordinates arcObj)) (setq p1 (vlax-safearray->list(vlax-variant-value startPnt1)) ) (setq x1 (carp1)) (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 (carp1)) (setq y2(cadr p1)) (setq z2(caddr p1)) ) (setq pp2(list x2 y2 z2)) ) ) (t ;;如果是其他种类线条 (progn (setq arcObj(VLAX-ENAME->VLA-OBJECT ss)) (setqstartPnt1 (vla-get-StartPoint arcObj)) ;;获取起点 (setq endPnt1(vla-get-EndPoint arcObj)) ;;获取终点 (setqpp1 (vlax-safearray->list(vlax-variant-value startPnt1)) ) (setq pp2(vlax-safearray->list (vlax-variant-value endPnt1)) ) ) ) ) (setq x1 (carpp1)) (setq y1(cadr pp1)) (setq z1(caddr pp1)) (setq x2 (carpp2)) (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"text" "j" "bc" pt "" (* (/ ang pi)180) (strcat"" (rtos dd 2)) "" ) (setq i (1+i))) (prin1) ) (prompt"\n <>在图中直接写出长度") (prin1) 3. 连续打断程序 (defun c:br1() (command"break" pause "f" pause "@") ) 4. 将CAD文字导入Excel表格 (defun c:Q2() (setq ffn(getfiled "写出文件" """xls" 1)) (princ"\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")) (prong (setq txt(cdr (assoc 1 ssdata))) (princ txtff) (princ"\n" ff))) (setq i (1+i)) ) (close ff) (princ(strcat "\n写出文件: " ffn)) (prin1) ) 5. 删除带颜色图元 (defunc:c1()(ssget)(command "chprop" "p" """c" "1" "") (princ)) (defunc:c2()(ssget)(command "chprop" "p" """c" "2" "") (princ)) (defunc:c3()(ssget)(command "chprop" "p" """c" "3" "") (princ)) (defunc:c4()(ssget)(command "chprop" "p" """c" "4" "") (princ)) (defunc:c5()(ssget)(command "chprop" "p" """c" "5" "") (princ)) (defunc:c6()(ssget)(command "chprop" "p" """c" "6" "") (princ)) (defunc:c7()(ssget)(command "chprop" "p" """c" "7" "") (princ)) (defunc:c8()(ssget)(command "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 (/= Anil)(progn (setq M(sslength A)) (command"erase" A "") (princ"\n共删除红色图元<")(princM)(princ ">个") )) (command"UNDO" "E") (princ) )
|