1.計(jì)算所有線段總長度(加載后只需框選所有線段便可得出這些線段的總長度)
(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.標(biāo)注所有線段(加載后只需框選所有線段便可得標(biāo)注這些線段)
(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)
;;獲取系統(tǒng)參數(shù)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))
;;輸入標(biāo)注文字高度
;;循環(huán)開始
(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))
   #p#分頁標(biāo)題#e# (setq y1 (cadr p1))
    (setq z1 (caddr p1))
    (setq pp1 (list x1 y1 z1))
    (repeat (- (/ (length p1) 3) 1)
      ;;循環(huán)，尋找最后一個控制點(diǎn)
      (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)
      ;;循環(huán)，尋找最后一個控制點(diǎn)
      (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))
    ;;獲取起點(diǎn)
    (setq endPnt1 (vla-get-EndPoint arcObj))
    ;;獲取終點(diǎn)
#p#分頁標(biāo)題#e#    (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))
  ;;取得線段兩端的中點(diǎn)
  (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.連續(xù)打斷程序
(defun c:br1 ()
  (command "break" pause "f" pause "@")
)

4.將CAD文字導(dǎo)入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)
) #p#分頁標(biāo)題#e# 

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 ">個")
             ))
 #p#分頁標(biāo)題#e#            (command "UNDO" "E")  
             (princ)  )  

這樣,鍵入 D1 命令,就可以刪除紅色的圖元了.