2009年7月6日 星期一

一些免費的 Autolisp <二>

自動歸類特定物件圖層


按一下自動歸類圖層,這是書本上的範例,稍稍改了一下真是很好用,不用一直切換圖層。
可以歸類如,Text 、Mtext 、DIM、Leader 、Qleader、Hatch 等物件到所屬圖層。

(defun c:CdimLayer ()
(setvar "CmdEcho" 0)
(CClay "DIM" 3 "DIMENSION")  ;; 這句表示:將DIMENSION 物件歸類到 3 綠色 ,DIM 圖層
(CClay "Text" 1 "Text");; 這句表示:將 Text 物件歸類到 1 紅色 , 圖層 Text
(CClay "Text" 1 "Mtext");; 這句表示:將 MText 物件歸類到 1 紅色 , 圖層 Text
(CClay "Dim" 3 "Leader");; 這句表示:將 Leader 物件歸類到 3 綠色 , 圖層 Dim
(CClay "Dim" 3 "Mleader");;這句表示:將 MLeader 物件歸類到 3 綠色 , 圖層 Dim
;;(CClay "Hatch" 55 "Hatch")

(setvar "CmdEcho" 1)
(prompt "\n =^.^= =^.^= =^.^=")
(princ)
)


;;************CClay (使用者勿修改副程式)******************
(defun CClay (layname cc sObjTyp) ;;;  layname 是圖層名稱,CC 是指訂圖層顏色,sObjtype 是物件類別(群碼索引值為 0)
(if (= nil (tblsearch "layer" layname))
(command "-layer" "n" layname "c" cc layname "")
)
(setq SS  (ssget "x" (list (cons 0 sObjTyp) (cons 410 "Model"))))
(if (and (/= nil ss) (/= 0 (sslength SS)))
(command "chprop" SS "" "la" layname "")
)

(princ)
)



將AutoCAD 圖面中所有的對齊式標註改成旋轉式標註

按一下將AutoCAD 圖面中所有的對齊式標註(dimaligned) 改成 旋轉式標註 (dimlinear) 線性標註,這是網路上撿來的,小弟修改原作者取群碼 G11 的錯誤,與使用此指令時使用者可能旋轉 UCS Z 軸的問題,讓標註更新時不會歪一邊或位置不同。

(defun c:DimA2R
(/ ss Ent EntData Pt1 Pt2 Pt3 ocmd omode olay odim)
(setq ocmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_end")
(command "_.undo" "_begin")
(setq omode (getvar "osmode"))
(setvar "osmode" 0)
(setq olay (getvar "clayer"))
(setq odim (getvar "dimstyle"))
(command "_.ucs" "W")
(if (setq ss (ssget "x" '((0 . "DIMENSION")) ))
(while (setq Ent (ssname ss 0))
(setq EntData (entget Ent))
(if (not (or (member '(100 . "AcDbRotatedDimension") EntData) (member '(100 . "AcDb2LineAngularDimension") EntData) ))
(progn
(setq Pt1 (cdr (assoc 13 EntData)))
(setq Pt2 (cdr (assoc 14 EntData)))
(setq Pt3 (cdr (assoc 10 EntData)))
(if (< (car Pt1) (car Pt2))      (command "_.ucs" "_3" Pt1 Pt2 (polar Pt1(+ (DTR 90.0) (angle Pt1 Pt2)) 50000000000.000 ))      (command "_.ucs" "_3" Pt2 Pt1 (polar Pt2(+ (DTR 90.0) (angle Pt2 Pt1)) 50000000000.000 ))    )    (setvar "clayer" (cdr (assoc 8 EntData)))    (command "_.dimstyle" "_r" (cdr (assoc 3 EntData)))    (entdel Ent)    (command "_.dim" "_horizontal" (trans Pt1 0 1) (trans Pt2 0 1) (trans Pt3 0 1) "" "_exit")    (command "_.ucs" "_p")  )      )      (ssdel Ent ss)    )  )  (command "_.dimstyle" "_r" odim)  (command "_.ucs" "_p")  (command "_.undo" "_end")  (setvar "clayer" olay)  (setvar "osmode" omode)  (setvar "cmdecho" ocmd)  (princ) )   (defun DTR (A) (* pi (/ A 180.0)))
# 一些免費的 AutoLisp <一> # 一些免費的 Autolisp <二> # 一些免費的 Autolisp <三> # 一些免費的 Autolisp <四>

沒有留言:

張貼留言