IT Knowledge Base

~ Without sacrifice, there can be no victory ~

發佈日期:

如何在AutoCAD中‧使用AutoLISP建立Dimension style

圖紙上需要尺寸標註,近乎是的絕對的工作,但對於AutoCAD內的Dimension style,多達數十項的設定,並不是每一個人或每一張圖紙需要的工作。

今次設計目的,是預設針對常會用到的尺寸標註,讓使用者只要輸入尺寸比例、圖紙比例、字高、正負公差值,便可產生一個新的Dimension style。

;Sub-program of C:CDS.
(DEFUN CREATE_DIMENSION_STYLE(A B C E / SO)
(SETQ SO (/ 1 A))
(COMMAND "STYLE" "ROMANS" "ROMANS" "" "" "" "" "" "")
(SETVAR "DIMTXSTY" "ROMANS")
(SETVAR "DIMLFAC" SO)
(IF (>= (ATOF (GETVAR "ACADVER")) 15.0)
(SETVAR "DIMDSEP" ".")
)
(SETVAR "DIMCLRT" 7)
(SETVAR "DIMDEC" 1)
(SETVAR "DIMTDEC" 1)
(SETVAR "DIMSAH" 1)
(SETVAR "DIMASZ" 2)
(SETVAR "DIMCEN" 0)
(SETVAR "DIMDLI" 1)
(SETVAR "DIMEXE" 1)
(SETVAR "DIMEXO" 1)
(SETVAR "DIMFIT" 3)
(SETVAR "DIMGAP" 1)
(SETVAR "DIMSCALE" C)
(SETVAR "DIMTAD" 1)
(SETVAR "DIMTFAC" 0.7)
(SETVAR "DIMTIH" 0)
(SETVAR "DIMTOFL" 1)
(SETVAR "DIMTOH" 0)
(SETVAR "DIMTOLJ" 0)
(SETVAR "DIMTXT" 2.5)
(SETVAR "DIMTZIN" 9)
(SETQ E0 (STRCAT E "$0"))
(SETQ E2 (STRCAT E "$2"))
(SETQ E3 (STRCAT E "$3"))
(SETQ E4 (STRCAT E "$4"))
(IF (OR (= B "Y") (= B "y"))
(PROGN
(SETVAR "DIMTOL" 1)
(SETVAR "DIMTP" D1)
(SETVAR "DIMTM" D2)
)
(SETVAR "DIMTOL" 0)
)
(COMMAND "DIM" "SAVE" E "Y" "E")
(SETVAR "DIMTOFL" 0)
(COMMAND "DIM" "SAVE" E0 "Y" "E")
(SETVAR "DIMTIH" 1)
(SETVAR "DIMTOFL" 1)
(SETVAR "DIMTOH" 1)
(COMMAND "DIM" "SAVE" E2 "Y" "E")
(SETVAR "DIMFIT" 1)
(SETVAR "DIMTIH" 0)
(SETVAR "DIMTOFL" 0)
(COMMAND "DIM" "SAVE" E3 "Y" "E")
;Use for AutoCAD R16 or later version.
(SETVAR "DIMUPT" 1)
;Use for AutoCAD R16 or later version.
(SETVAR "DIMTMOVE" 1)
(COMMAND "DIM" "SAVE" E4 "Y" "E")
(COMMAND "DIM" "RESTORE" E "E")
)

;Sub-program of C:CDS.
(DEFUN CHANGE_DOT_TO_TEXT(D100 / FLAG D101) 
(SETQ FLAG 1)
(SETQ D102 "")
(WHILE (/= (SUBSTR D100 FLAG 1) "")
(SETQ D101 (SUBSTR D100 FLAG 1))
(IF (= D101 ".")
(SETQ D101 "D")
)
(SETQ D102 (STRCAT D102 D101))
(SETQ FLAG (+ FLAG 1))
)
)

;Main program
(DEFUN C:CDS (/ A B C D1 D2 D11 D12 D13 D21 D22 D23 E0 E2 E3 E4 FLAG)
(PROMPT "\\nCreate dimension style.")
(GRAPHSCR)
(SETVAR "CMDECHO" 0)
(SETQ C (GETREAL "\\nEnter the all dimension scale <0.8>: "))
(IF (= C nil)
(SETQ C 0.8)
)
(INITGET (+ 1 2))
(SETQ A (GETREAL "\\nEnter drawing scale: "))
(INITGET (+ 1 2))
(SETQ A1 (RTOS A))
(SETQ C1 (RTOS C))
;Call sub-program CHANGE_DOT_TO_TEXT.
(CHANGE_DOT_TO_TEXT A1) 
(SETQ A1 D102)
;Call sub-program CHANGE_DOT_TO_TEXT.
(CHANGE_DOT_TO_TEXT C1)
(SETQ C1 D102)
(INITGET 1 "Y N")
(SETQ B (GETKWORD "\\nEnable tolerance : "))
(IF (OR (= B "Y") (= B "y"))
(PROGN
(INITGET 1)
(SETQ D1 (GETREAL "\\nEnter the upper tolerance: "))
(INITGET 1)
(SETQ D2 (GETREAL "\\nEnter the lower tolerance: "))
(SETVAR "DIMZIN" 9)
(SETQ D11 (RTOS D1))
(SETQ D21 (RTOS D2))
;Call sub-program CHANGE_DOT_TO_TEXT.
(CHANGE_DOT_TO_TEXT D11) 
(SETQ D11 D102)
;Call sub-program CHANGE_DOT_TO_TEXT.
(CHANGE_DOT_TO_TEXT D21)
(SETQ D21 D102)
(SETQ E (STRCAT "DS" A1 "-TP" D11 "-TM" D21 "-OS" C1))
;Call sub-program CREATE_DIMENSION_STYLE.
(CREATE_DIMENSION_STYLE A B C E)
)
(PROGN
(SETVAR "DIMZIN" 9)
(SETQ E (STRCAT "DS" A1 "-OS" C1))
;Call sub-program CREATE_DIMENSION_STYLE.
(CREATE_DIMENSION_STYLE A B C E)
)
)
(SETVAR "CMDECHO" 1)
(PRINC)
)

發佈留言

發佈留言必須填寫的電子郵件地址不會公開。 必填欄位標示為 *