2014年9月6日 星期六

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




標籤: , ,

0 個意見:

張貼留言

訂閱 張貼留言 [Atom]

<< 首頁