1、計(jì)算CAD圖形中所有線(xiàn)段總長(zhǎng)度(加載后只需框選所有線(xiàn)段便可得出這些線(xiàn)段的總長(zhǎng)度)

　　(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 "所選線(xiàn)條總長(zhǎng)為：")(princ ll)(princ)

　　)

2、標(biāo)注CAD圖形中所有線(xiàn)段(加載后只需框選所有線(xiàn)段便可得標(biāo)注這些線(xiàn)段)

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

　　)

　　;;選取需要測(cè)量的樣條曲線(xiàn)、圓弧、直線(xiàn)、橢圓

　　(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)開(kāi)始

　　(repeat (sslength en)

　　(setq ss (ssname en i))

　　(setq endata (entget ss))

　　(command "lengthen" ss "")

　　(setq dd (getvar "perimeter"))

　　(princ (strcat "\n長(zhǎng)度=" (rtos dd 2)))

　　;;尋找代表圖層的字符串

　　(setq aa (assoc 0 endata))

　　;;獲取圖層名稱(chēng)

　　(setq aa1 (cdr aa))

　　;;判斷線(xiàn)條種類(lèi)

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

　　;;循環(huán)，尋找最后一個(gè)控制點(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)，尋找最后一個(gè)控制點(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

　　;;如果是其他種類(lèi)線(xiàn)條

　　(progn

　　(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))

　　(setq startPnt1 (vla-get-StartPoint arcObj))

　　;;獲取起點(diǎn)

　　(setq endPnt1 (vla-get-EndPoint arcObj))

　　;;獲取終點(diǎn)

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

　　;;取得線(xiàn)段兩端的中點(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 <>在圖中直接寫(xiě)出長(zhǎng)度")

　　(prin1)

3、連續(xù)打斷程序

　　(defun c:br1 ()

　　(command "break" pause "f" pause "@")

　　)

4、將CAD文字導(dǎo)入Excel表格

　　(defun c:Q2()

　　(setq ffn (getfiled "寫(xiě)出文件" "" "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寫(xiě)出文件: " ffn))

　　(prin1)

　　)

5、刪除帶顏色圖元

　　以下程序在別人的貼子里貼過(guò).為了說(shuō)明問(wèn)題,今天再貼一次。

　　改顏色的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 命令就可以將圖元改為紅色了.其余類(lèi)似。

　　刪除紅色圖元

　　(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 ">個(gè)")

　　))

　　(command "UNDO" "E")

　　(princ) )

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