Im tra st ntica mt Linetype

Một phần của tài liệu vba_cad_25_8_08 (Trang 67 - 69)

VI. Làm v ic vi Group

Kim tra st ntica mt Linetype

• T i m t linetype vào trong b n v và chuy n m t Linetype thành d ng đ ng hi n hành. • i tên và xóa m t d ng đ ng.

• Thi t l p và l y các thông s v linetype's scale và description.

Truy c p Linetypes trong VBA

Dim objLinetypes As AcadLineTypes Set objLinetypes = ThisDrawing.Linetypes

tham chi u đ n m t đ i t ng LineTypeTo có s n, s d ng ph ng th c Item: Dim objLinetype As AcadLineType

Set objLinetype = objLinetypes.Item(Index)

Set objLinetype = objLinetypes.Item(NameLinetype)

NameLinetype ki u string là tên d ng đ ng đã đ c load vào trong b n v

Index ki u interger, c ng gi ng nh trong Layer Collection, Index n m t 0 đ n (Linetypes.Count – 1).

Gi ng nh t t c các collection khác trong AutoCAD, Ph ng th c Item là ph ng th c m c đnh trong Linetypes collection.

Ki m tra s t n t i c a m t Linetype

Public Sub CheckForLinetypeByIteration() Dim objLinetype As AcadLineType

Dim strLinetypeName As String

strLinetypeName = InputBox("Enter a Linetype name to search for: ") If "" = strLinetypeName Then Exit Sub ' exit if no name entered

For Each objLinetype In ThisDrawing.Linetypes

If 0 = StrComp(objLinetype.Name, strLinetypeName, vbTextCompare) Then MsgBox "Linetype '" & strLinetypeName & "' exists"

Exit Sub ' exit after finding linetype End If B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

MsgBox "Linetype '" & strLinetypeName & "' does not exist"

End Sub

Ngoài ra ta có th b y l i đ ki m tra s t n t i c a m t LineType : Public Sub CheckForLinetypeByException()

Dim strLinetypeName As String Dim objLinetype As AcadLineType

strLinetypeName = InputBox("Enter a Linetype name to search for: ") If "" = strLinetypeName Then Exit Sub ' exit if no name entered On Error Resume Next ' handle exceptions inline Set objLinetype = ThisDrawing.Linetypes(strLinetypeName) If objLinetype Is Nothing Then ' check if obj has been set MsgBox "Linetype '" & strLinetypeName & "' does not exist" Else

MsgBox "Linetype '" & objLinetype.Name & "' exists" End If

nd Sub

T i m t Linetype vào trong b n v

Cú pháp Load lintype nh sau :

Set LinetypeObject = LinetypesCollection.Load(LinetypeName, LinetypeFilename)

NAME DATA TYPE DESCRIPTION

LineTypeName String Tên c a linetype

LinetypeFilename String ng d n c a file ch a LineType c n Load Ví d : ThisDrawing.Linetypes.Load “Hidden”, "acad.lin"

Chuy n Linetype thành d ng đ ng hi n hành S d ng ph ng th c ActiveLinetype nh sau : DocumentObject.ActiveLinetype = LinetypeObject Ví d sau bi n d ng đ ng "TRACKS" thành d ng đ ng hi n thành c a b n v hi n hành : ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes("TRACKS") i tên Linetype (adsbygoogle = window.adsbygoogle || []).push({});

S d ng thu c tính Linetype.Name property, b n có th thay đ i tên c a m t d ng đ ng.

Deleting a Linetype

Ph ng th c Linetype.Delete cho phép b n xóa m t đ i t ng Linetype t Linetypes collection.

LinetypeObject.Delete

Ta không th xóa m t d ng đ ng ra kh i b n v khi :

• Nó là linetype hi n hành.

• Nó là ByLayer, ByBlock, or Continuous linetype. • Nó là m t Xref-dependent linetype. L y Hanhdle c a Linetype B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

Dim objLinetype As AcadLinetype Dim strLinetypeHandle As String

Set objLinetype = ThisDrawing.Linetypes("Center") strLinetypeHandle = objLinetype.Handle

Thay đ i Description c a Linetype.

AutoCAD Cho phép b n read, add ho c modify description c a LineType b ng cách s d ng ph ng th c Description c a Linetype object.

Dim strLineTypeDescription As String

objLineType.Description = "Linetype Description: -.-.-." strLineTypeDescription = objLineType.Description

The following example changes a Linetype description based on user input:

Scaling Linetypes

B n có th đ s d ng hai lo i t l phóng : global linetype scale (LTSCALE) và individual linetype scale (CELTSCALE).

Global Scale

Dim dblNewLTScale As Double

ThisDrawing.SetVariable "LTSCALE", 2#

dblNewLTScale = ThisDrawing.GetVariable("LTSCALE")

Individual Scale

Dim dblNewCELTScale As Double

ThisDrawing.SetVariable "CELTSCALE", 2#

dblNewCELTScale = ThisDrawing.GetVariable("CELTSCALE")

Một phần của tài liệu vba_cad_25_8_08 (Trang 67 - 69)