多语言展示
当前在线:1228今日阅读:23今日分享:25

几个很有用的CAD的lisp程序

几个很有用的CAD的lisp程序,给大家分享一下
工具/原料

《AutoCAD视频教程全集》地址在参考资料里哦

计算所有线段总长度(加载后只需框选所有线

(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))

标注所有线段(加载后只需框选所有线段便可

(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 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))    )    (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))  (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)

连续打断程序

(defun c:br1 ()  (command "break" pause "f" pause "@"))

将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))

删除带颜色图元

改颜色的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技巧、知识在经验下方的《AutoCAD视频教程全集》里。

注意事项

参考资料里的是官方唯一发布的

推荐信息