CAD中有關lisp程序的繪圖技巧

當我們在使用CAD軟件繪制圖紙時，經常會因為各種需求，需要了解一些軟件的系統程序，對我們使用軟件會有幫助的。那浩辰CAD中關于lisp程序有哪些繪圖技巧呢？今天就為大家簡單介紹下。

CAD中的一些關于lisp程序的繪圖技巧：

 1、計算CAD圖形中所有線段總長度(加載后只需框選所有線段便可得出這些線段的總長度)

(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、標注CAD圖形中所有線段(加載后只需框選所有線段便可得標注這些線段)

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

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軟件中，當我們在使用CAD軟件繪圖時，我們可以了解一些軟件的程序，可以參考上述內容。今天就介紹這么多了。安裝浩辰CAD軟件試試吧。更多CAD教程技巧，可關注浩辰CAD官網進行查看。