Etiketler

Youtube Kanalıma Abone Olunuz

17 Mart 2018 Cumartesi

AutoCAD ile VBA Makro Kullanımı #3

Önceki Bölüm: AutoCAD ile VBA Makro Kullanımı #2

AutoCAD ile VBA Makro kullanımı ile ilgili uygulamalar:
Videoda kullanılan kodlar:

Autocad VBA ile Çizgi Rengini Değiştirme:

Sub CizgiRengiDegis()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
Dim cizgi As AcadLine
Dim n1(2) As Double, n2(2) As Double

n1(0) = 0 'X
n1(1) = 0 'Y

n2(0) = 50 'X
n2(1) = 70 'Y

Set cizgi = ModelSpace.AddLine(n1, n2)
cizgi.color = acCyan

Regen acActiveViewport

n1(0) = 10 'X
n1(1) = 20 'Y

MsgBox "devam"

cizgi.StartPoint = n1
cizgi.color = 220

End Sub

Autocad VBA ile Çizgi Rengini Değiştirme 2:

Sub CizgiRengiDegis2()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
Dim cizgi As AcadLine
Dim n1(2) As Double, n2(2) As Double

n1(0) = 0 'X
n1(1) = 0 'Y

n2(0) = 50 'x

For r = 1 To 255
    n2(1) = r
    Set cizgi = ModelSpace.AddLine(n1, n2)
    cizgi.color = r
Next

End Sub

Autocad VBA ile Katman Ekleme:


Sub KatmanEkle()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
On Error Resume Next
Dim eksenKatman As AcadLayer
Set eksenKatman = Layers.Item("Eksen")
If Err.Number = -2145386476 Then
    Linetypes.Load "ACAD_ISO10W100", "acad.lin"
    Set eksenKatman = Layers.Add("Eksen")
    eksenKatman.color = acCyan
    eksenKatman.Linetype = "ACAD_ISO10W100"
End If
End Sub
'--------------------------------------
Sub KatmanEkle2()
    'Makro: Mesut Akcan 18/7/2019 www.akcansoft.com
    Dim eksenKatman As AcadLayer
    Set eksenKatman = Layers.Add("Eksen")
    On Error Resume Next
    Linetypes.Load "CENTER", "acad.lin"
    eksenKatman.color = acCyan
    eksenKatman.Linetype = "CENTER"
End Sub

Autocad VBA ile Katman Rengini Değişme:


Sub katmanrenginidegis()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
    Dim aktifkatman As AcadLayer
    Set aktifkatman = ActiveLayer
    aktifkatman.color = acBlue
End Sub

Autocad VBA ile Katman Çizgi Tipini Değiştirme:

Sub katmanCizgiTipiDegis()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
On Error Resume Next
Dim aktifkatman As AcadLayer
Linetypes.Load "ACAD_ISO10W100", "acad.lin"

Set aktifkatman = ActiveLayer
aktifkatman.Linetype = "ACAD_ISO10W100"
End Sub

Autocad VBA ile Eksen Çizme:


Sub EksenCiz()
'Makro: Mesut Akcan 17/3/2018 www.akcansoft.com
On Error Resume Next
Dim nesne As AcadCircle

Linetypes.Load "ACAD_ISO10W100", "acad.lin"
ActiveLinetype = Linetypes.Item("ACAD_ISO10W100")

Utility.GetEntity nesne, nkt, "Nesne seçiniz"

'merkeznokta = Utility.GetPoint(, "Merkez noktasını giriniz") 'X,Y,Z
merkeznokta = nesne.Center

'merkeznokta(0) ->X
'merkeznokta(1) ->Y
'merkeznokta(2) ->Z

'uzunluk = Utility.GetDistance(merkeznokta, "Kol uzunluğunu giriniz")
uzunluk = nesne.Radius + 3

n1 = merkeznokta
n2 = merkeznokta

n1(0) = merkeznokta(0) - uzunluk 'X
n2(0) = merkeznokta(0) + uzunluk 'X

Set cizgi = ModelSpace.AddLine(n1, n2)

n1 = merkeznokta
n2 = merkeznokta

n1(1) = merkeznokta(1) - uzunluk 'Y
n2(1) = merkeznokta(1) + uzunluk 'Y

Set cizgi = ModelSpace.AddLine(n1, n2)

ActiveLinetype = Linetypes.Item("Continuous")

End Sub

Sonraki bölüm: AutoCAD ile VBA Makro kullanımı #4-1

İlgili video:

Hiç yorum yok:

Yorum Gönder