由圖塊或外部參考 快速產生 Xclip

BTC  改版了，並且在實用性上改進了，自動產生斷折線

值得一提的是現在Xclip 一選就可以調整大小，你不必再去切換顯示或關閉切割邊界，對整個工作校能來說是非常棒的一個改進。

2018.04.17 更新 :
不論使用者怎麼亂操作作都不會當，不限制左上右下、
右下左上、右上左下，左下右上等選取方式。
間隔比例由 Dimscale 控制，Xclip間隔一定是 DimScale的10倍，
使用者不必選取切割次數，隨時按下 ESC 結束程式，便恢復系統設定。

Divside 以期望的值作等分

以期望的值作等分，配合新版AutoCAD ，列出鄰近分割值及等分長度

根據目前的標註形式 更新所有的標註形式 除了整體比例

緣起

如果你是傳統的AutoCAD 使用者，並且是用舊的標註比例控制的方式，你總會遇到一個痛處，就是在眾多標註形式中，萬一你想變更某一小設定，你要變更每一個型式的設定。

萬一你在一個圖檔中用了10 種標註形式那真的是噩夢.........

為了這個問題我收集了很多相關資訊打算自己做一個對話視窗來一次改變設定等等，但是過程中我發現，只需要簡單的指令就能做到

例如 ( command  "-dimstyle" "save" "y") 

本來是千行程式碼的大作，變成不到 50 行的小品。 

先為者個指令建立一個按鈕，命令列鍵入 CUI

這部分很簡單，照圖面做一個按鈕 (1)

(3)按鈕圖形部分選一個現有的圖形自己改一下，非常簡單。

(2) Macro 部分 ^C^C_UADFC  就是他的指令

按鈕做好用滑鼠拉到工具列就可以用了

接著使用方式及載入程式，請觀賞影片

載入的時候記得將檔案格式改成 *.VLX 載入 UADFC.VLX 就能用了

影片中 content 再加入一次就是每次開啟AutoCAD 他就會自動載入。

下載位址 :  https://www.dropbox.com/s/ftcrazh0m2ju7gk/UADFC.VLX?dl=0

Autolisp 讓文字大小，Mleader比例自動跟著標註設定

複製下程式碼，存成  Mtext.lsp 並載入

(defun c:MaxText (/ dimscal )
  ;;------------- 支援 annotative ---------------------
  (if (= 1 (getvar "DIMANNO"))
    (progn
      (setq dimscal (/ 1 (getvar "cannoscalevalue")))
      (setvar "TextSize" (* dimscal 3))
    )
    (progn
      (setq dimscal (getvar "dimscale"))
      (setvar "TextSize" (* dimscal 3))
    )
  ) ;_if
  ;;------------- 支援 annotative ---------------------
  (setvar "clayer" "text")  ;_切換圖層
  (initdia)  ;;強制顯示下個 command 的 dialog box 
  (command "mtext")
  (princ)
) ;_defun


記得在contents 再加入一次，以後AutoCAD 啟動就會自動載入

接著只要在 cui 找到 Multiline Text  將 Macro 改成 ^C^C_MaxText 就可以了

這個程式的好處在於不論你是用傳統的方式或 Annotative  的標註，他都會自動調整文字大小到目前標註設定的大小。

例如 CNS 1:1 時字高為 3~3.5mm
程式會根據標助比例調整字高。

你完全不需要再去調整字型設定，但是要注意的是 TextStyle 的字高一定要設定成 0 。

Mleader 也可以自動設定，完全不必再去調整其大小

上述程式簡單改一改就可以 
(setvar "MLEADERSCALE" dimscal)


(defun c:MaxMleader (/ dimscal )
  ;;------------- 支援 annotative ---------------------
  (if (= 1 (getvar "DIMANNO"))
    (progn
      (setq dimscal (/ 1 (getvar "cannoscalevalue")))
    )
    (progn
      (setq dimscal (getvar "dimscale"))
      (setvar "MLEADERSCALE" dimscal)
    )
  ) ;_if
  ;;------------- 支援 annotative ---------------------
  (setvar "clayer" "dim")  ;_切換圖層
  (initdia)  ;;強制顯示下個 command 的 dialog box 
  (command "mleader")
  (princ)
) ;_defun


如此一來不論是傳統的一個標註型式一個比例的用法，或是Annotative 的用法，都不必再調整字高，或Mleader 形式，只要切換標註比例 (DimScale )，或是Annotative 比例，他就能自動切換。

2D 斷面物理性質 及 如何撰寫 Autolisp

這個程式想寫很久了，最近終於完成了，實際花費時間大概是4天。
含注解大約 1130 行 ，我發現專注力還是蠻強的，只是體力不行了 XD



除了AI 程式撰寫，對一般程式設計來說都是一樣的，可以用一句話概括 :

程式設計就是  輸入 及  輸出 。

就以此程式為例

你要輸出什麼?  你要輸入什麼?

1.面積 ，你得安排一個程式
(defun ShapeArea (obj / )
   ;;內容先不管
)

2.周長
(defun ShapePerimeter (obj /  ))

3.邊界座標
(defun ShapeBoundingBox (Obj /  ))

4.形心座標
(defun ShapCenter (obj /  ))
.......

對於該程式傳入的是物件 所以給予參數 obj 的名稱
對於每個輸出應該是什麼型別，你也應當標示 :

(defun ShapeArea (obj / )) ;_string
(defun ShapePerimeter (obj /  )) ;_string
(defun ShapeBoundingBox (Obj /  )) ;_pointList
(defun ShapCenter (obj /  )) ;_point
.......

接著對每個上述副程式做測試

(defun c:test ( / Obj CenterPt  )
  ;;*********** centroid 形心副程式 *************
  (defun ShapCenter (obj / o c)
    ;;程式碼 
    bula bula bula ........
  ) ;_傳回 point

  (setq Obj (ssget))
  (setq CenterPt (ShapCenter Obj))
  (command "point" CenterPt "")
)

這些工作都不會白做，這個測試用的程式也表達了副程式呼叫的方式。你可以註解的形式，為該副程式加上呼叫方式的註解。

(defun ShapCenter (obj /  )) ;_point
;;呼叫方式 (setq CenterPt (ShapCenter Obj))
;; 參數為Region 物件。

甚至可以用Xmind 或 Visio 等軟體會制流程，順著這個架構，安排好 
輸入 及輸出，讓方向明確，架構清楚，效率也會好很多。

還有就是不要懶惰不寫注解，有一天你進步了，你想大改某支程式，沒註解你就要全部重新理解，浪費時間。

變數的使用，則要一眼能看出他的作用與型別例如:

AreaStr
LeftTopPt
AreaReal

用途與型別一眼就知道。

另外就是lisp 的一個特色

(defun c:test ( 傳入參數  傳入參數 / 本地化變數 本地化變數  ......  )

你可以在一個 程序 Procedure 或 函數 Function 中任意宣告一個變數，但是他是 Public，不只同檔案可以存取，其他檔案也可以，那真是噩夢一場，
所以你一定要將每個變數本地化。

對於公有變數你一定要加上 Public_變數名稱_型別 ，否則在除錯的過程這些都是噩夢，當然這種公有變數的使用並不多。

程序 Procedure 或 函數 Function  也是一樣，如果只有這個程式用到
儘量將其包含在該程式中，以避免同名稱的問題例如:

(defun c:test ( / Obj CenterPt  )
  ;;*********** centroid 形心副程式 *************
  (defun ShapCenter (obj / o c)
    ;;程式碼 
    bula bula bula ........
  ) ;_傳回 point

  (setq Obj (ssget))
  (setq CenterPt (ShapCenter Obj))
  (command "point" CenterPt "")
)

Lsip 其實超級簡單易用

所有的指令函式甚至結構式都可以概括成一種形式


(指令 名稱  參數)
(程序 名稱  參數 參數 參數)
(算子 名稱  參數)

例如 :

(defun ShapeArea (obj / )) ;_string

這裡 defun 是說你要定義一個程序或函式
ShapeArea  是其名稱
obj 是你要傳入的參數
/ 之後的為該函式的私有變數


(+ 1  1 )
加為其指令
後面是兩個參數或更多個參數

像這類測試你可以直接在 console 測試

每個括號前後快速的點兩下滑鼠，他都會告訴你對稱的範圍。

(defun c:test ( / )
  ;;*********** centroid 形心副程式 *************  
  (defun ShapCenter (obj / o c)
    ;;程式碼 
    bula bula bula ........
  ) ;_傳回 point

  ;;-------------- 主程式 ------------------  
  (setq Obj (ssget))  ;_ Obj 變數 一定要是Region
  (setq CenterPt (ShapCenter Obj)) ;_ 呼叫 ShapCenter 函數 
  (command "point" CenterPt "") ;_ 輸出繪製點 
) ;_ defun


想想是不是一句話就能概括?

程式設計就是  輸入 及  輸出 。

我就是這樣開始寫的，這句話是一位朋友當年跟我講的，當時我是寫Foxpro  和 Delphi  (Pascal)  ，其他程式設計的細節呢?

按 F1  鍵

完整的手冊就跳出來



在比較舊的版本都是CHM 檔案，這是我最愛的一種，因為可以用 CyberArticle  轉出來。

很可惜現在都改成Html 格式，個人覺得很不方便。

AutoCad 在切換 layout 非常緩慢 的問題解決辦法

當你的在繪製大型建物時 AutoCAD 2010 或較新的版本，當你圖面擁有大量圖塊，外部參考及大量配置時，在切換配置時(Layout) 會非常緩慢，找遍國外網站都看不到有效的解決方式。

其中最有用的是 LAYOUTREGENCTL 系統變數設定成 2 。

他的作用是每當你切換配置時，他會在記憶體中快取該配置，這必須在你下次切換回來時才看得到差異，第一次切換他還是會重生 regen 計算精確值，我有些圖檔竟然需要30秒，根本不合工作效益。我不想在工作時不斷等待，有時我只是要看一下其他圖面，取得一些資訊。

有沒辦法一次快取全部配置以及模型空間呢呢?   

上網找了相關的 Autolisp 的資料，決定轉寫這個程式....


-------------------------------------» 閱讀全文 »

Autolisp Mleader Align

因為 AutoCAD 內建的 Mleader 對齊的功能實在很難用，而 Mleader 又是獨立於DIMSTYLE 可以分開管理並且跟 MText 物件連在一起的，於是我改寫了Max-Qleader 引線標注功能，變成 Max-Mleader ，與 Mleader 新的對齊功能，延續TrimDim 化條線就對齊的設計概念，Mleader Align 也是畫一條線就對齊。



Mleader 使用上非常方便 但相對 DXF 中 GroupCode 相對複雜，很多特徵是相同的例如:

  (
    (-1 . )
    (0 . "MULTILEADER")
    (330 . )
    (5 . "1F075")
    (100 . "AcDbEntity")
    (67 . 0)
    (410 . "Model")
    (8 . "Dim")
    (100 . "AcDbMLeader")
    (270 . 2)
    (300 . "CONTEXT_DATA{")
    (40 . 15.0)
    (10 7271.46 9881.71 0.0)
    (41 . 52.5)
    (140 . 30.0)
    (145 . 30.0)
    (174 . 2)
    (175 . 2)
    (176 . 1)
    (177 . 0)
    (290 . 1)
    (304 . "M5圓頭螺絲")
    (11 0.0 0.0 1.0)
    (340 . )
    (12 7415.04 9907.96 0.0)
    (13 1.0 0.0 0.0)
    (42 . 0.0)
    (43 . 0.0)
    (44 . 0.0)
    (45 . 1.0)
    (170 . 1)
    (90 . -1023410166)
    (171 . 2)
    (172 . 5)
    (91 . -1073741824)
    (141 . 0.0)
    (92 . 0)
    (291 . 0)
    (292 . 0)
    (173 . 0)
    (293 . 0)
    (142 . 0.0)
    (143 . 0.0)
    (294 . 0)
    (295 . 0)
    (296 . 0)
    (110 6680.17 9364.02 0.0)
    (111 1.0 0.0 0.0)
    (112 0.0 1.0 0.0)
    (297 . 0)
    (302 . "LEADER{")
    (290 . 1)
    (291 . 1)
    (10 7241.46 9881.71 0.0)
    (11 1.0 0.0 0.0)
    (90 . 0)
    (40 . 30.0)
    (304 . "LEADER_LINE{")
    (10 6680.17 9364.02 0.0)
    (91 . 0)
    (170 . 1)
    (92 . -1056964608)
    (340 . )
    (171 . -2)
    (40 . 0.0)
    (341 . )
    (93 . 0)
    (305 . "}")
    (271 . 0)
    (303 . "}")
    (272 . 9)
    (273 . 9)
    (301 . "}")
    (340 . )
    (90 . 67421184)
    (170 . 1)
    (91 . -1073741824)
    (341 . )
    (171 . -1)
    (290 . 1)
    (291 . 1)
    (41 . 2.0)
    (42 . 2.0)
    (172 . 2)
    (343 . )
    (173 . 2)
    (95 . 2)
    (174 . 1)
    (175 . 0)
    (92 . -1023410166)
    (292 . 0)
    (93 . -1056964608)
    (10 1.0 1.0 1.0)
    (43 . 0.0)
    (176 . 0)
    (293 . 0)
    (294 . 0)
    (178 . 0)
    (179 . 2)
    (45 . 15.0)
    (271 . 0)
    (272 . 9)
    (273 . 9)
    (295 . 1)
  )

10 作為索引就出現了四次，所以assoc 指令不論往前找或是往後找，你都找不到
中間那兩個，所以必須先撰寫一個副程式，來取得你想要的那個，並且取得其順序以供 nth 使用。

以圖面來說，只要你更新 P2 並以其為對齊點便可，不需要去操作P4(文字的對齊點)，而P3 非常重要，他是判斷使用者到底是向左還是向右標。在程式碼中僅是這麼簡單幾句

;;--------------;; update P2 and justify  -------------------
      (setq ent (subst (cons 10 int1)
      (nth nthP2 ent)
      ent
)
      ) ;;p2
      (entmod ent)
      (if (= t (vlax-property-available-p vlaobj 'TextJustify))
(vlax-put vlaobj 'TextJustify 2)
      )
      (vlax-release-object vlaobj);;不要去變更 P4


程式還不完美，但是比起內建更加快速好用，其他的待工作空閒時再來修改。

一些免費的 Autolisp <五> 快速變更 標註的 ArrowType

這程式幫你快速切換標註箭頭形式(Arrow Type)，也幫你關閉同一側的延伸線(Extension Line) ，當你再次執行他會變更方向，這常用於標註斷折線以外的必須表示的尺寸。

載入後

命令列輸入 :  arrowext

也可以在cui 自己做個按鈕，巨集寫法如下圖

原始碼:

(defun c:ArrowEXT (/ obj arrow arrow1 arrow2)
  (vl-load-com)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
  (setq mSpace (vlax-get-property acadDocument 'Modelspace))

  (setq obj (vlax-ename->vla-object
       (car (entsel "\n 請選取標註 : "))
     )
  )
  (setq arrow1 (vlax-get obj 'Arrowhead1Type))
  (setq arrow2 (vlax-get obj 'Arrowhead2Type))
  (AE-SetVartoDwg "AW2" arrow2)
  (AE-SetVartoDwg "AW1" arrow1)
  (cond
    ((= arrow2 arrow1)
     (progn
       (if
  (and
    (vlax-property-available-p obj 'Arrowhead1Type)
    (vlax-property-available-p obj 'Arrowhead2Type)
    (vlax-property-available-p obj 'ExtLine2Suppress)
    (vlax-property-available-p obj 'ExtLine1Suppress)
  )
   (progn
     (setq arrow (AE-GetVarFromDwg "AW1" "def"))
     (vlax-put obj 'Arrowhead1Type 0)
     (vlax-put obj 'Arrowhead2Type arrow)
     (vlax-put obj 'ExtLine1Suppress 1)
     (vlax-put obj 'ExtLine2Suppress 0)
   )
       )
     )
    )
    ((= arrow1 0)
     (progn
       (if
  (and
    (vlax-property-available-p obj 'Arrowhead1Type)
    (vlax-property-available-p obj 'Arrowhead2Type)
    (vlax-property-available-p obj 'ExtLine2Suppress)
    (vlax-property-available-p obj 'ExtLine1Suppress)
  )
   (progn
     (setq arrow (AE-GetVarFromDwg "AW2" "def"))
     (vlax-put obj 'Arrowhead1Type arrow)
     (vlax-put obj 'Arrowhead2Type 0)
     (vlax-put obj 'ExtLine1Suppress 0)
     (vlax-put obj 'ExtLine2Suppress 1)
   )
       )
     )
    )
    ((= arrow2 0)
     (progn
       (if
  (and
    (vlax-property-available-p obj 'Arrowhead1Type)
    (vlax-property-available-p obj 'Arrowhead2Type)
    (vlax-property-available-p obj 'ExtLine2Suppress)
    (vlax-property-available-p obj 'ExtLine1Suppress)
  )
   (progn
     (setq arrow (AE-GetVarFromDwg "AW1" "def"))
     (vlax-put obj 'Arrowhead1Type 0)
     (vlax-put obj 'Arrowhead2Type arrow)
     (vlax-put obj 'ExtLine1Suppress 1)
     (vlax-put obj 'ExtLine2Suppress 0)
   )
       )
     )
    )
  )
  (vlax-release-object obj)
  (vlax-release-object acadObject)
  (princ)
)


;;;********************* function GetVarFromDwg *************************
(defun AE-GetVarFromDwg (VarName Def)
  (vlax-ldata-get "ArrowExt" VarName Def t)
)


;;;********************* function SetVartoDwg ***************************
(defun AE-SetVartoDwg (VarName input)
  (vlax-ldata-put "ArrowExt" VarName input)
)

不喜歡 AutoLisp 的 Polar 函數?

因為 Polar 函數的角度參數為弧角，對某些人可能很習慣，我是覺得蠻抓狂的，常常都是在0 90 180 270 的轉換使用，所以角度寫法都變成 (* 0 pi) (* 0.5 pi)  pi  (* 1.5 pi) ，其實只要簡單改寫成如下:

P-De 可以利用 【基準點】、【角度】、【距離】、【標記】，四個參數來取得相對點位。
這個角度非弧角是 Degrees

;;;************************************************************************
(defun P-De (BasePoint Degrees Dist Mark / ang return-Pt)
  (setq ang (* pi (/ Degrees 180.0)))
  (setq NPt (polar BasePoint ang Dist))
  (if (/= Mark "")
    (command "text" "J" "MC" NPt "3" "0" Mark "")
  )
  (setq return-Pt NPt)
)

NPXY 可以利用 【基準點】、【X軸】、【Y軸】、【標記】，四個參數來取得相對點位。

;;;************************************************************************
(defun NPXY
   (BasePoint Xaxis Yaxis Mark / Ptx PtY ang1 ang2 return-Pt)
  (setq ang1 (* 0 pi))
  (setq ang2 (* 0.5 pi))
  (setq Ptx (polar BasePoint ang1 Xaxis))
  (setq PtY (polar Ptx ang2 Yaxis))
  (if (/= Mark "")
    (command "text" "J" "MC" PtY "3" "0" Mark "")
  )
  (setq return-Pt PtY) ;回傳值
)

其中第四個參數【標記】是除錯用的 。

參考下圖，我打算利用 NPXY 這個改寫的新函數來繪製 RH 並且變成通用程式。
先做一個測試用基本框架，由於RH 型鋼決定於五個參數 H B T1 T2 R 先給定值做測試用如下:

(defun c:pp (/ H B T1 T2 R PIns)
  (setq PIns (getpoint
      (strcat "請點選基準點 : ")
    )
  )

  (setq
    H  150
    B  75
    T1 5
    T2 7
    R  8
  )

  (RH-Draw H B T1 T2 R PIns)
)

接著在AutoCAD 中繪製該RH 所有其他點位接參考 P1，再利用 PIns 決定P1位置，為了不用輸入負值，以左下為 P1



對這個圖形來說X軸只有 0 、(- (/ B 2) (/ T1 2 ) R)、(- (/ B 2) (/ T1 2 ) )、(+ (/ B 2) (/ T1 2 ) )、(+ (/ B 2) (/ T1 2 ) R)、B 幾種 ，其中0 的有 P1 、P16、P10、P11，就一次寫在 X 軸，(- (/ B 2) (/ T1 2 ) R) 為P12、P15 也是這樣類推 ，很輕鬆的就全部相對點位都出來了。

接著我們要撰寫主結構中的   (RH-Draw H B T1 T2 R PIns)  圖形繪製程式

(defun RH-Draw (H    B  T1   T2   R PIns /   P1 P2   P3  P4
P5   P6  P7   P8   P9 P10  P11  P12 P13  P14  P15
P16
      )
  (setq
    P1 (NPXY PIns (* -1 (/ B 2)) (* -1 (/ H 2)) "")
    P2 (NPXY P1 B 0 "")
    P3 (NPXY P1 B T2 "")
    P4 (NPXY P1 (+ (/ B 2) (/ T1 2) R) T2 "")
    P5 (NPXY P1 (+ (/ B 2) (/ T1 2)) (+ T2 R) "")
    P6 (NPXY P1 (+ (/ B 2) (/ T1 2)) (- H T2 R) "")
    P7 (NPXY P1 (+ (/ B 2) (/ T1 2) R) (- H T2) "")
    P8 (NPXY P1 B (- H T2) "")
    P9 (NPXY P1 B H "")
    P10 (NPXY P1 0 H "")
    P11 (NPXY P1 0 (- H T2) "")
    P12 (NPXY P1 (- (/ B 2) (/ T1 2) R) (- H T2) "")
    P13 (NPXY P1 (- (/ B 2) (/ T1 2)) (- H T2 R) "")
    P14 (NPXY P1 (- (/ B 2) (/ T1 2)) (+ T2 R) "")
    P15 (NPXY P1 (- (/ B 2) R) T2 "")
    P16 (NPXY P1 0 T2 "")
  )

  (command "Pline" P1 P2     P3     P4     "Arc"  P5
  "Line" P6 "Arc" P7     "Line" P8     P9    P10
  P11  P12 "Arc" P13    "Line" P14    "Arc"  P15
  "Line" P16 P1 ""
 )
)

由於要在中軸作插入點因此P1 必須參考自 PIns 所以原本的

 P1 (NPXY PIns 0 0 "")

改成

 P1 (NPXY PIns (* -1 (/ B 2)) (* -1 (/ H 2)) "")

完整的測試碼如下:

(defun c:pp (/ H B T1 T2 R PIns)
  (setq PIns (getpoint
        (strcat "請點選基準點 : ")
      )
  )

  (setq
    H  150
    B  75
    T1 5
    T2 7
    R  8
  )

  (RH-Draw H B T1 T2 R PIns)
)

;;;************************************************************************

(defun RH-Draw (H    B   T1   T2   R  PIns /    P1 P2   P3   P4
  P5   P6   P7   P8   P9  P10  P11  P12 P13  P14  P15
  P16
        )
  (setq
    P1 (NPXY PIns (* -1 (/ B 2)) (* -1 (/ H 2)) "")
    P2 (NPXY P1 B 0 "")
    P3 (NPXY P1 B T2 "")
    P4 (NPXY P1 (+ (/ B 2) (/ T1 2) R) T2 "")
    P5 (NPXY P1 (+ (/ B 2) (/ T1 2)) (+ T2 R) "")
    P6 (NPXY P1 (+ (/ B 2) (/ T1 2)) (- H T2 R) "")
    P7 (NPXY P1 (+ (/ B 2) (/ T1 2) R) (- H T2) "")
    P8 (NPXY P1 B (- H T2) "")
    P9 (NPXY P1 B H "")
    P10 (NPXY P1 0 H "")
    P11 (NPXY P1 0 (- H T2) "")
    P12 (NPXY P1 (- (/ B 2) (/ T1 2) R) (- H T2) "")
    P13 (NPXY P1 (- (/ B 2) (/ T1 2)) (- H T2 R) "")
    P14 (NPXY P1 (- (/ B 2) (/ T1 2)) (+ T2 R) "")
    P15 (NPXY P1 (- (/ B 2) R) T2 "")
    P16 (NPXY P1 0 T2 "")
  )



  (command "Pline"  P1 P2     P3     P4     "Arc"  P5
    "Line" P6  "Arc" P7     "Line" P8     P9     P10
    P11   P12  "Arc" P13    "Line" P14    "Arc"  P15
    "Line" P16  P1 ""
   )
)



;;;************************************************************************
(defun P-De (BasePoint Degrees Dist Mark / ang return-Pt)
  (setq ang (* pi (/ Degrees 180.0))) ; 轉換成弧角
  (setq NPt (polar BasePoint ang Dist)) ;取得新點位 
  (if (/= Mark "")   ;除錯檢查用可以在點位給定標籤
    (command "text" "J" "MC" NPt "3" "0" Mark "")
  )
  (setq return-Pt NPt)   ;回傳值
)


;;;************************************************************************
(defun NPXY
     (BasePoint Xaxis Yaxis Mark / Ptx PtY ang1 ang2 return-Pt)
  (setq ang1 (* 0 pi))
  (setq ang2 (* 0.5 pi))
  (setq Ptx (polar BasePoint ang1 Xaxis)) ; X 方向暫存點
  (setq PtY (polar Ptx ang2 Yaxis)) ; Y 方向取得新點位
  (if (/= Mark "")   ;除錯檢查用可以在點位給定標籤
    (command "text" "J" "MC" PtY "3" "0" Mark "")
  )
  (setq return-Pt PtY)   ;回傳值
)

如果你在第四個參數【標記】加入字串如:

    P1 (NPXY PIns (* -1 (/ B 2)) (* -1 (/ H 2)) "P1")
    P2 (NPXY P1 B 0 "P2") ..... 中略

    P9 (NPXY P1 B H "P9")
    P10 (NPXY P1 0 H "P10")

圖形便會出現標籤，如前面的說明這是為除錯用的

你可以再操控 H B T1 T2 R PIns 四個參數就可以繪製所有 RH 剖面了。
回想以前寫過的程式片段...

  (setq p1 (polar insPt (* 0.5 pi) (/ H 2.0)))
  (setq p1 (polar p1 pi (/ B 2)))
  (setq x (/ (- B (+ t1 R R)) 2))
  (setq y (- H (+ t2 t2 R R)))
  (setq P2 (polar p1 (* 0 pi) B))
  (setq P3 (polar p2 (* 1.5 pi) t2))
  (setq P16 (polar p1 (* 1.5 pi) t2))
  (setq P4 (polar p3 (* 1 pi) x))
  (setq P15 (polar p16 (* 0 pi) x))
  (setq c1 (polar p4 (* 1.5 pi) R))
  (setq c2 (polar p15 (* 1.5 pi) R))
  (setq P5 (polar c1 (* 1 pi) R))
  (setq P14 (polar c2 (* 0 pi) R))
  (setq P6 (polar p5 (* 1.5 pi) y))
  (setq P13 (polar p14 (* 1.5 pi) y))
  (setq c3 (polar p6 (* 0 pi) R))
  (setq c4 (polar p13 (* 1 pi) R))
  (setq P12 (polar c4 (* 1.5 pi) R))
  .........

天阿自己要改寫或除錯都很暈 ，而且用了很多參考點位。

Autolisp 欄位轉成多行文字 Field to MText

寫這個程式的原因是之前寫了將標註尺寸對應到欄位的程式，在繪圖下料時使用，能減少許多錯誤 (尺寸變化文字就變化)。

問題是有些人使用免費的CAD 如 DraftSight，在讀取 AutoCAD 檔案時，附加的欄位屬性會變成文字公式......

網路上找了許多版本，好像都蠻失敗的，欄位轉成多行文字，這轉換上似乎有點困難。但是如果使用MText 做為加入資料自動計算的欄位，炸開就可以了很簡單的回復成一般的文字物件，而且很正常，缺點是會變成單行文字。

那需要做的事簡單的說就是

1. 在選取時僅選中欄位文字 ( FieldMText )
2. 炸開欄位文字 ( FieldMText ) 並取回被炸開的 ( Text ) 物件
3. 再將  ( Text ) 物件 轉回 MText

(defun c:exf ()
  (prompt
    "\n注意!!這程式會炸開所有欄位"
  )
  (setq ss (ssget))
  (setq ss (SSEntTyp ss 0 "MTEXT"))
  (setq ss (SSEntTyp ss 102 "{ACAD_XDICTIONARY")) ;;選取欄位文字物件
  (setvar "qaflags" 1)
  (if (and (/= nil ss) (/= 0 (sslength ss)))
    (setq ss (ExplodeAndGetExplodedObject ss)) ;;炸開並取回炸開物件
  )
  (SScvMtext ss) ;;將被炸開的物件轉回多行文字
  (setvar "qaflags" 0)
  (princ)
)


;;;*************************   只選取欄位文字物件    **********************
(defun SSEntTyp (SSrex index entype /  n endata enNamen ssExcluded result)
   (if (/= SSrex nil)
     (progn
       (setq ssExcluded (ssadd))
       (setq n 0)
       (repeat (sslength SSrex)
     (setq enNamen (ssname SSrex n))
     (setq endata (entget enNamen))
     (if (= (cdr (assoc index endata)) entype)
       (progn
        (print entype)
        (print (cdr (assoc index endata)))
            (setq ssExcluded (ssadd enNamen ssExcluded))
       )
     )
     (setq n (+ n 1))
       )
     )
   )
          (setq result ssExcluded)
)

;;;***********************  炸開並取回炸開物件 **************************
(defun ExplodeAndGetExplodedObject (SS          /         i
                   n          enNameI     enNameN
                   ssuni      ssuni2     ssExclude
                   ssexploded result
                  )
  (if (/= SS nil)
    (progn
      (setq ssuni (ssget "x"))
      (setq i 0)
      (repeat (sslength SS)
    (setq enNameI (ssname SS i))
    (setq ssExclude (ssdel enNameI ssuni))
    (setq i (+ 1 i))
      )
      (setvar "qaflags" 1)
      (command "explode" SS "")
      (setvar "qaflags" 2)
      (setq ssuni2 (ssget "x"))
      (setq n 0)
      (repeat (sslength ssExclude)
    (setq enNameN (ssname ssExclude n))
    (setq ssexploded (ssdel enNameN ssuni2))
    (setq n (+ 1 n))
      )
    )
    (exit)
  )
  (setq result ssexploded)
)


;; ********* 轉換成 Mtext 副程式 ************
(defun SScvMtext( SS / )
  (if (/= ss nil)
    (progn
      (setq len (sslength ss))
      (while (> len -1)
 (setq txtName (ssname ss len))
 (command "txt2mtxt" txtName "");; 呼叫 express 程式
 (setq len (- len 1))
      )
     )
   )
)

就是這樣間接的將欄位 ( Field-MText ) 轉成多行文字 ( MText )

相關文章

http://wildkidblog.blogspot.tw/2012/10/autocad.html
http://wildkidblog.blogspot.tw/2010/07/autocad.html
http://wildkidblog.blogspot.tw/2010/08/autolisp-exclude-entites-from-selection.html

AutoCAD 取得任何物件的屬性成為欄位

最重要的如上圖第二張選擇 object  之後他會出現選取物件的箭頭按鈕，這時候選擇物件後就會列出所有該物件的屬性。

如例子中我選擇 .Measurement 他就會顯示尺寸標註的值。

有關單位的進階設定則跟標註設定都一樣。
本文後面，作者 Lee Mac  的程式就是拼出這段句子

%<\AcObjProp.16.2 Object(%<\_ObjId 8796088410192>%).Measurement \f "%lu2%pr1%zs8">%


 在實際的工作中像這個例子的使用方式實在沒有效率，不如以 Lee Mac的程式來得簡單俐落，要改寫程式則需要知道這個基本的使用方法。

相關的還有關閉欄位的背景色系統變數 FIELDDISPLAY
更新欄位可以用儲存 QSave 或是 UPDATEFIELD

Autolisp 將標註物件的測量值連結到文字欄位的方式 

一直想要的功能，將標註轉換成文字欄位(field)
還有加總數值文字物件變成欄位物件，這樣一來就不會改東忘西了。

感謝李麥克 lee mac 的範例，使用時不要重複點選標註，會加總喔。
以下改寫自李麥克的程式範例

-------------------------------------» 閱讀全文 »

autolisp 建築圖面門窗統計

寫了好幾天的程式終於成功了，只要輸入門窗編號，不論是單行文字、多行文字或屬性圖塊做的標註文字，都可以快速篩選，並且統計數量。

不然建築圖密密麻麻的，從地下室統計到屋凸多算幾次眼睛真的會蝦掉內 ......

這支程式遇到大小寫混用也沒問題

搜尋前 會先變成大寫

(setq serchtxt (strcase (getstring nil "\n 請輸入門窗編號 : ")))

在過濾條件大小寫都會被找到

 (setq sel (ssget "_W"
             spt1
             spt2
             (list (cons 0 "TEXT") (CONS -4 ""))
          )
    )


屬性圖塊可以用這個程式修改成副程式（網路上找到的）



;;;(defun c:sk (/ ent)
;;;
;;;  (if (and (setq ent (car (entsel "\nSelect an Attributed Block: ")))
;;;       (eq "INSERT" (dxf 0 ent))
;;;       ;;(= 1 (dxf 66 ent))
;;;      )
;;;
;;;    (while (not (eq "SEQEND" (dxf 0 (setq ent (entnext ent)))))
;;;      (princ (strcat "\n\nAtt_Tag:"
;;;             (dxf 2 ent)
;;;             "\nAtt_Value: "
;;;             (dxf 1 ent)
;;;         )
;;;      )
;;;    )
;;;  )
;;;
;;;  (princ)
;;;)


這裡的 ent 實際是 entname



最好玩的是我發現有些建築師或事務所的員工不會使用屬性圖塊，而用文字或多行文字放在圖塊中.......... 一點實用性都沒有的使用方式。

所以還得補足這兩種情況這程式才完整 .... 世事難料阿

當然可以用 express tools 裡面有個 burst 可以把圖塊或屬性圖塊炸開變成一般文字。burst  在 15 層的平面圖或更高的樓層，速度會變成非常慢，可以去拉屎、喝咖啡、甚至洗個澡電腦都沒還算完.......

Autolisp CopyRotate.LSP 複製物件後旋轉角度 示範使用 NEntSS 副程式

CopyRotate.LSP  作用是複製物件後旋轉角度，在此是示範使用 NEntSS副程式，展示 NEntSS  如何讓你在撰寫 Autolisp 時思路變得非常簡單，並且能很輕易就保留指令本身的視覺回饋效果。

;;************************************************************ 
;;* CopyRotate.LSP                                           * 
;;************************************************************ 
;;* 複製物件後旋轉角度                                       * 
;;* (c) Copyright 2009 Max T.                                * 
;;* 有點像複製+對齊指令 =^.^=                                * 
;;************************************************************ 
(defun C:CR (/ *error* olderr OSM Ooth obj Nobj ssoldx BasePt 
AliPT LP DP ang dist input default )
  ;;儲存系統變數**********************************************
  (command "undo" "group")
  (setq olderr *error*)
  (setq *error* DetectError)
  (setq OSM (getvar "OSMODE"))
  (setq Ooth (getvar "OrthoMode"))
  (setvar "OrthoMode" 0)
  (setvar "CMDECHO" 0)
  ;;主程式****************************************************
  (while (= obj nil)
    (princ "\n *.* 選擇要旋轉複製物件 :")
    (setq obj (ssget))
  );;while
  (setq BasePt (getpoint "\n *.* 請點選複製旋轉的基準點 :"))
  (setq AliPT (getpoint BasePt "\n *.* 請選擇對齊點"))
  (print "選擇複製目標點 : ")
  (setq ang (angle BasePt AliPT ))
  (setq dist (distance BasePt AliPT))
  (setq ssoldx (ssget "x")) ;;取得現有的物件的總集合
  (command "_.copy" obj "" BasePt pause)
  (setq LP (getvar "Lastpoint")) ;;取得上一個指令的最後選取點 !!
  (setq DP (polar LP ang dist)) ;;取得上一個指令的最後選取點的相對位置!!
  (setq Nobj (NentSS ssoldx));;排除舊物件的集合
  (command "_.rotate" Nobj "" LP "R" LP DP )
  ;;回復系統變數**********************************************
  (setq *error* olderr)
  (setvar "OrthoMode" Ooth)
  (command "undo" "end")
  (setvar "CMDECHO" 1)
  (print " =^.^= =^O^=")
  (princ)
)
;;endDefun


;;;;;********************* function DectectError *********************
(defun DetectError (s)
  (if (/= s "程式錯誤")
    (princ (strcat "\nError: " s))
  )
  (setq *error* olderr)
  (setvar "OSMODE" OSM)
  (setvar "OrthoMode" Ooth)
  (command "undo" "end")
  (setvar "CMDECHO" 1)
  (print "使用者強制關閉")
  (princ)
)

;;****      角度徑度轉換        ***** ;;
(defun Radian->Degrees (nbrOfRadians)
  (* 180.0 (/ nbrOfRadians pi))
)


;;**************************************************************************;;
;;****   取得 command 新產生物件選集                                    ****;;
;;****   必須在產生物件的動作前取得舊選集(setq ssoldx (ssget "x"))      ****;;
;;**************************************************************************;;
(defun NentSS (oldSSx / NewSSx i enNameI ssExclude result)
  (setq NewSSx (ssget "x"))
  (setq i 0)
  (if (/= oldSSx nil)
    (progn
      (repeat (sslength oldSSx)
 (setq enNameI (ssname oldSSx i))
 (setq ssExclude (ssdel enNameI NewSSx))
 (setq i (+ 1 i))
      ) ;;repeat
    );;progn
    (exit)
  )
  ;;if
  (setq result ssExclude)
)

使用方式

1.選取您要複製並旋轉的物件
2.選取複製基準點(也是旋轉的中心點)
3.選取對齊點，這點是物件要選轉對齊的點
4.選取複製目標點(也是新的物件旋轉的中心點)
5.輸入角度 或是 依導引線決定角度

若您會撰寫 Autolisp 您就會發現主程式極其簡單，也不必為了保有視覺回饋效果絞盡腦汁，做一堆的假動作來達到視覺回饋效。這個副程式讓撰寫 Autolisp 工作輕鬆太多了 ...

Autolisp 排除選集中特定物件 Exclude Entites from selection set

;;************************************************************************************;;
;;***********          排除選集中特定物件       **************************************;;
;;************************************************************************************;;
(defun SSEntTypExclude (SSrex entype / i n endata enNamen ssExcluded result)
  (if (/= SSrex nil)
    (progn
      (setq ssExcluded (ssadd))
      (setq n 0)
      (repeat (sslength SSrex)
    (setq enNamen (ssname SSrex n))
    (setq endata (entget enNamen))
    (if (= (cdr (assoc 0 endata)) entype)
      (progn 
       (print entype)
       (print (cdr (assoc 0 endata)))
           (setq ssExcluded (ssadd enNamen ssExcluded))
      );;progn
    );;if
    (setq n (+ n 1))
      ) ;;repeat
    );;progn
  );;if

  (if (/= ssExcluded nil)
    (progn
      (setq i 0)
      (if (> (sslength ssExcluded) 0)
    (progn 
      (repeat (sslength ssExcluded)
    (setq enNameI (ssname ssExcluded i))
    (setq ssresult (ssdel enNameI SSrex))
    (setq i (+ 1 i))
      );;repeat
      (setq result ssresult)
      );;progn
    (setq result SSrex)
    );;if
    )
    ;;progn
  )
) 

您只要反向操作，這個程式也可以選中特定型態....

範例1
(defun c:Tt (/ ss)
  (setq ss (ssget))
  (setq ss (SSEntTyp ss "DIMENSION"))
  (command "erase" ss "")
)

範例1.不管選中什麼 TT 只幫你刪掉標註

範例2
(defun c:Tt2 (/ ss Dss Lss)
  (setq ss (ssget))
  (setq Dss (SSEntTyp ss "DIMENSION"))
  (setq Lss (SSEntTyp ss "LEADER"))
  (command "erase" Dss "")
  (command "erase" Lss "")
)

範例2.不管選中什麼 TT 只幫你刪掉標註及引線

(defun SSEntTyp (SSrex entype /  n endata enNamen ssExcluded result)
   (if (/= SSrex nil)
     (progn
       (setq ssExcluded (ssadd))
       (setq n 0)
       (repeat (sslength SSrex)
     (setq enNamen (ssname SSrex n))
     (setq endata (entget enNamen))
     (if (= (cdr (assoc 0 endata)) entype)
       (progn
        (print entype)
        (print (cdr (assoc 0 endata)))
            (setq ssExcluded (ssadd enNamen ssExcluded))
       );;progn
     );;if
     (setq n (+ n 1))
       ) ;;repeat
     );;progn
   );;if
          (setq result ssExcluded)
   )

取得 command 新產生物件選集

點這裡看實作範例

..

;;************************************************************************************;;
;;***********        取得 command 新產生物件選集                     *****************;;
;;*********         必須在產生物件的動作前取得舊選集(setq ssoldx (ssget "x"))    *****;;
;;************************************************************************************;;
(defun NewEntSS (oldSSx / NewSSx i enNameI ssExclude result)
  (setq NewSSx (ssget "x"))
  (setq i 0)
  (if (/= oldSSx nil)
    (progn
      (repeat (sslength oldSSx)
    (setq enNameI (ssname oldSSx i))
    (setq ssExclude (ssdel enNameI NewSSx))
    (setq i (+ 1 i))
      )
      ;;repeat
    )
    ;;progn
    (exit)
  )
  ;;if
  (setq result ssExclude)
)

AutoCAD 中當有物件被炸開之後，該物件選集便消失了，那怎麼取回被炸開後的那些物件呢?

AutoCAD 中當有物件被炸開之後，該物件選集便消失了，那怎麼取回被炸開後的那些物件呢?
找了好多網路文章 ... 想到黑眼圈都跑出來了.... 失敗了N 次，也沒人可問，乾脆寫信給國外的高手 :P 糗~~

他回答我 :

1. Selection Set 1 : Get selection set of everything in the drawing.

2. Remove the block that is about to be exploded from the set.

3. Explode the block.

4. Selection Set 2 :Get another selection set containing everything in the drawing.

5. Remove everything in Selection Set 2 that exist in Selection Set 1

6. Selection Set 2 should now contain the entities of the exploded block.

看到之後真是太開心了，他的回答的確可行，立刻隔著太平洋給他三拜。

他是這麼說 :
1. 取得圖中所有物件選集 (setq ssuni (ssget "x"))
2. 移除你要炸開的物件 (ssdel eni ss)
3. 炸開該物件 (command "explode" ss )
4. 再選一次所有物件，這次便會包含被炸開的物件 (setq ssuni2 (ssget "x"))
5. (setq ssuni2 (ssget "x")) - [(setq ssuni (ssget "x"))-SS]
6. 這樣就剩下被炸開的物件 exploded


接著冰雪聰明的我立刻寫出一個副程式就是下面安ㄋ :



這傻蛋又在陶醉了....

(defun ExplodeAndGetExplodedObject (SS          /         i
                   n          enNameI     enNameN
                   ssuni      ssuni2     ssExclude
                   ssexploded result
                  )
  (if (/= SS nil)
    (progn
      (setq ssuni (ssget "x"))
      (setq i 0)
      (repeat (sslength SS)
    (setq enNameI (ssname SS i))
    (setq ssExclude (ssdel enNameI ssuni))
    (setq i (+ 1 i))
      )
      ;;repeat

      (setvar "qaflags" 1)
      (command "explode" SS "")
      (setvar "qaflags" 2)

      (setq ssuni2 (ssget "x"))
      (setq n 0)
      (repeat (sslength ssExclude)
    (setq enNameN (ssname ssExclude n))
    (setq ssexploded (ssdel enNameN ssuni2))
    (setq n (+ 1 n))
      )
      ;;repeat
    )
    ;;progn
    (exit)
  )
  ;;if
  (setq result ssexploded)
)
;;defun

相關文章

一些免費的 Autolisp <四>

很多年前寫的 AutoLisp (不含原始碼) 跟各位分享，輸入規格自動繪製公制結構鋼材斷面

鋼鐵手冊 http://tech.ths.com.tw/ths1/directory.htm

用起來覺得還是比動態圖塊要快得多





MaxSteel 結構鋼斷面繪製工具
設計動機 : 由於鋼結構斷面規格頗多製成Block 或撰寫以DCL 對話框之ListBox 挑選之方式皆不便
故採用直接輸入規格的方式繪製結構鋼斷面 , 這幾個程式與您分享 .

(感謝Jimmo 網友提供功能表檔STEEL.MNS 及安裝說明

安裝
1複製MaxSteel 資料夾至電腦硬碟
2開啟AUTOCAD (2002以上版本)
→工具
→載入應用程式
→載入 MaxSteel.VLX
→啟動套件
→加入 MaxSteel.VLX
→關閉

→工具
→自訂
→功能表
→瀏灠 將STEEL.MNS 載入
→關閉

→工具
→環境選項
→選擇 檔案 標纖
→支援搜尋路徑
→加入
→瀏覽 將C:\MaxSteelSource 加入
→上移 將C:\MaxSteelSource 移到最上層

MaxSteel 用法

STEELFC
指令: _SteelFc
請輸入 槽鋼 高度<75>:
請輸入 槽鋼 寬度<40>:
請輸入 槽鋼 腹板厚度<5>:
請輸入 槽鋼 翼板厚度<7>:
大圓角值1<8>:
小圓角值2<4>:
請選擇插入點:
(自動產生Label ) C-75x40x5x7
------------------------------------------------------------------------
STEELLC
指令: _SteelLC
請輸入輕型鋼 高度<75>:
請輸入輕型鋼 寬度<40>:
請輸入輕型鋼 回折<15>:
請輸入輕型鋼 厚度<1.6>:
請選擇插入點:
(自動產生Label ) C-75x40x15x1.6
------------------------------------------------------------------------
STEELLL
指令: _SteelLL
請輸入角鋼 邊長<100>:
請輸入角鋼 邊長<100>:
請輸入角鋼 厚度<7>:
請輸入角鋼 大圓角<10>:
請輸入角鋼 小圓角<5>:
請選擇插入點:
(自動產生Label ) L-100x100x7t
------------------------------------------------------------------------
STEELPFC
指令: _SteelPFC
請輸入 PFC 槽鋼 高度<380>:
請輸入 PFC 槽鋼 寬度<100>:
請輸入 PFC 槽鋼 腹板厚度<11>:
請輸入 PFC 槽鋼 翼板厚度<19>:
大圓角值<15>:
請選擇插入點:
(自動產生Label ) PFC-380x100x11x19
------------------------------------------------------------------------
STEELRH
指令: _SteelRH
請輸入 H-Pin 高度<350>:
請輸入 H-Pin 寬度<175>:
請輸入 H-Pin 腹板厚度<7>:
請輸入 H-Pin 翼板厚度<11>:
圓角值<13>:
請選擇插入點:
(自動產生Label ) RH-350x175x7x11
PL 繪製工具
MaxRectangle
MaxRectangleU
MaxRectangleD
註: 三指令共用一字典變數值( 非常方便 )
<模式一>
指令: _Maxrectangle
填滿位置(基準點)或設定W寬度<30>
填滿長度第二點:
<模式二>
指令: _MaxRectangle
填滿位置(基準點)或設定W寬度<30>w (註:可螢幕取點當板厚或手動輸入板厚)
請輸入W寬度值:<30>6
填滿位置(基準點)或設定W寬度<6>
填滿長度第二點:

MaxCub(邊長繪製正方形)
指令: _MaxCub
請輸入寬度值W 或點選螢幕上兩點<1.6>:
點選螢幕以決定寬度<1.6>:2


下載位置 : http://www.4shared.com/file/117517113/bb390035/MaxSteel___.html


# 一些免費的 AutoLisp <一>


# 一些免費的 Autolisp <二>


# 一些免費的 Autolisp <三>


# 一些免費的 Autolisp <四>

一些免費的 Autolisp <三>

"*************************************************************************"
"** (c) Copyright 2009 Wildkid T. 所有權利保留 **"
"** 2009.06.21 AM 01:05 於 AutoCAD 2010 環境測試完成 **"
"** 使用說明 :支持台灣建國的使用者，無須付費即可使用此軟體。 **"
"**-------------------------------------------------------------------- **"
"**------------------------ 請支持台灣建國 ---------------------------- **"
"** 年輕的朋友們，在我的記憶中，國民黨執政都是狠狠的剝削人民， **"
"** 這個極富有且貪婪的政黨...至今依舊如此，相信你們今天都感受到了。 **"
"** 吃飽沒? 這種打招呼方式大概又要回來了，馬英九執政這年有4000人自殺。 **"
"** 歷史不能遺忘，當你遺忘歷史，歷史就會重演。 **"
"*************************************************************************"

點兩點，籬選線性標註，標註將對齊籬選線，延伸線只選到一半也行!
這個程式應該建築業的會喜歡。

注意! 在修剪標註前，所有對齊式標註將會被修改成線性標註(旋轉式標註) "只有"被選中的標註 ExtensionLineOffset 會自動設為 0 。

這個程式跟以前某位建築師寫的建築套件一樣，但他的程式在旋轉UCS 就會產生錯誤，我的版本不論怎麼轉都不會錯誤。

這是小弟第一次試著透過 ActiveX 存取物件的程式。

(無原始碼)


執行巨集 ^C^C_TriDim

2009.09.06 更新版本
下載位置 : http://www.4shared.com/file/130556873/280c646a/TriDim.html


# 一些免費的 AutoLisp <一>


# 一些免費的 Autolisp <二>


# 一些免費的 Autolisp <三>


# 一些免費的 Autolisp <四>

一些免費的 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 <四>

Access ActiveX object with Autolisp

在搜尋許多高手的Autolisp 會發現他們使用一些 Active X 的擴充函數，在developer documentation 的說明中又找不到這類函數的說明怎麼解決這個問題呢?

試著在 developer documentation 搜尋 ActiveX ，在 Vlax-get-property 中有個完整的範例 :

以下是使用 ActiveX 的定型範例
(vl-load-com) ;;<-----use activeX function
(setq acadObject (vlax-get-acad-object))
(setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
(setq mSpace (vlax-get-property acadDocument 'Modelspace))

轉換Autolisp entity 到ActiveX 物件

(setq vlaobj (vlax-ename->vla-object enname))
enname 是 entity名稱

ent 來自 entsel 函數傳回entity名稱

(setq enname (car ent))

ent 來自 entget 函數傳回群碼列表

(setq enname (cdr(assoc -1 ent)))

重點來了，怎麼找到該屬性的名稱?

在 AutoCAD Toolplate 的Autolisp Expression
填入這句

(vlax-dump-object (vlax-Ename->Vla-Object (car (entsel))) T)

點選你要列示的物件它的屬性就會在文字視窗例 :

Command: (vlax-dump-object (vlax-Ename->Vla-Object (car (entsel))) T)
Select object: ; IAcadLWPolyline: AutoCAD Lightweight Polyline Interface
; Property values:
; Application (RO) = #
; Area (RO) = 9660.3
; Closed = -1
; ConstantWidth = 0.0
; Coordinate = ...Indexed contents not shown...
; Coordinates = (894.159 2258.2 894.159 2246.2 1699.18 2246.2 ... )
; Document (RO) = #
; Elevation = 0.0
; Handle (RO) = "1CA6B"
; HasExtensionDictionary (RO) = 0
; Hyperlinks (RO) = #
; Layer = "0"
; Length (RO) = 1634.05
; Linetype = "ByLayer"
; LinetypeGeneration = 0
; LinetypeScale = 1.0
; Lineweight = -1
; Material = "ByLayer"
; Normal = (0.0 0.0 1.0)
; ObjectID (RO) = 2128989720
; ObjectName (RO) = "AcDbPolyline"
; OwnerID (RO) = 2128948472
; PlotStyleName = "ByLayer"
; Thickness = 0.0
; TrueColor = #
; Visible = -1
; Methods supported:
; AddVertex (2)
; ArrayPolar (3)
; ArrayRectangular (6)
; Copy ()
; Delete ()
; Explode ()
; GetBoundingBox (2)
; GetBulge (1)
; GetExtensionDictionary ()
; GetWidth (3)
; GetXData (3)
; Highlight (1)
; IntersectWith (2)
; Mirror (2)
; Mirror3D (3)
; Move (2)
; Offset (1)
; Rotate (2)
; Rotate3D (3)
; ScaleEntity (2)
; SetBulge (2)
; SetWidth (3)
; SetXData (2)
; TransformBy (1)
; Update ()
T

列出一堆。

存取屬性的方法

取得屬性
(vlax-get-property object property)
範例:

(setq col (getstring "\nNew Color Number: "))
(vlax-put-property obj 'color col)

修改屬性
(vlax-put-property obj property arg)
範例:

(vlax-put-property vlaobj 'ExtensionLineOffset 0)

(setq pos (getpoint "\nNew Position:"))
(vlax-put-property obj 'textalignmentpoint (vlax-3d-point pos) )