几个很有用的中望CAD的lisp程序

好酷屋教程网小编为您收集和整理了几个很有用的中望CAD的lisp程序的相关教程：1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(defunc:LL()(setvar"cmdecho"1)(setqen(ssget(list(0."spl

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 en (ssget(list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0);;获取系统参数textsize(setq shh (getvar "textsize"))(setq str_hh (strcat "\n文字高度<" (rtos shh 2) ">: "))(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 (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 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 startPnt1 (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 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));;获取终点(setq pp1(vlax-safearray->list (vlax-variant-value startPnt1)))(setqpp2 (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))(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"))(progn(setq txt (cdr (assoc 1 ssdata)))(princ txt ff)(princ "\n" ff)))(setq i (1+ i)) )(close ff)(princ (strcat "\n写出文件: " ffn))(prin1))

5删除带颜色图元

以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ))(defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (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 "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共删除红色图元<")(princ M)(princ ">个")))(command "UNDO" "E")(princ))这样,键入 D1 命令,就可以删除红色的图元了。

以上就是好酷屋教程网小编为您收集和整理的几个很有用的中望CAD的lisp程序相关内容，如果对您有帮助，请帮忙分享这篇文章^_^

本文来源： https://www.haoku5.com/IT/6455f6b90e1ef098af0b911d.html

相关推荐