五个实用的AutoCAD的lisp程序

  (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 命令,就可以删除红色的图元了。