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)
;;選取需要測(cè)量的樣條曲線、圓弧、直線、橢圓
(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))
(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
;;如果是其他種類線條
(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))
;;取得線段兩端的中點(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)
)
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 ">個(gè)")
))
(command "UNDO" "E")
(princ) )
這樣,鍵入 D1 命令,就可以刪除紅色的圖元了。
推薦閱讀:CAD環(huán)形彈簧的繪
推薦閱讀:CAD培訓(xùn)
·中望CAx一體化技術(shù)研討會(huì):助力四川工業(yè),加速數(shù)字化轉(zhuǎn)型2024-09-20
·中望與江蘇省院達(dá)成戰(zhàn)略合作:以國產(chǎn)化方案助力建筑設(shè)計(jì)行業(yè)數(shù)字化升級(jí)2024-09-20
·中望在寧波舉辦CAx一體化技術(shù)研討會(huì),助推浙江工業(yè)可持續(xù)創(chuàng)新2024-08-23
·聚焦區(qū)域發(fā)展獨(dú)特性,中望CAx一體化技術(shù)為貴州智能制造提供新動(dòng)力2024-08-23
·ZWorld2024中望全球生態(tài)大會(huì)即將啟幕,誠邀您共襄盛舉2024-08-21
·定檔6.27!中望2024年度產(chǎn)品發(fā)布會(huì)將在廣州舉行,誠邀預(yù)約觀看直播2024-06-17
·中望軟件“出海”20年:代表中國工軟征戰(zhàn)世界2024-04-30
·玩趣3D:如何應(yīng)用中望3D,快速設(shè)計(jì)基站天線傳動(dòng)螺桿?2022-02-10
·趣玩3D:使用中望3D設(shè)計(jì)車頂帳篷,為戶外休閑增添新裝備2021-11-25
·現(xiàn)代與歷史的碰撞:阿根廷學(xué)生應(yīng)用中望3D,技術(shù)重現(xiàn)達(dá)·芬奇“飛碟”坦克原型2021-09-26
·我的珠寶人生:西班牙設(shè)計(jì)師用中望3D設(shè)計(jì)華美珠寶2021-09-26
·9個(gè)小妙招,切換至中望CAD竟可以如此順暢快速 2021-09-06
·原來插頭是這樣設(shè)計(jì)的,看完你學(xué)會(huì)了嗎?2021-09-06
·玩趣3D:如何巧用中望3D 2022新功能,設(shè)計(jì)專屬相機(jī)?2021-08-10
·如何使用中望3D 2022的CAM方案加工塑膠模具2021-06-24
·CAD中對(duì)標(biāo)注使用格式刷卻沒有反應(yīng)是為什么?2024-03-22
·CAD使用拉長命令繪制圖形的各種應(yīng)用2018-12-10
·找不到視口邊界2017-02-13
·CAD中插入塊的技巧介紹2024-08-21
·CAD中圖元編組了但卻失效的原因2024-07-31
·CAD中圓角、倒角的一些技巧2018-04-27
·CAD如何清理未使用的線型?2021-03-29
·CAD陣列后的圖形如何修剪2021-04-26