Etiketler

AutoCAD (63) bedava (48) Dosya (34) Resim (33) program (21) Ziyaretçi Defteri (20) excel (18) Eğitim (17) Güncelleme (17) Nasıl yapılır (16) asgbookphp (16) VBA (15) Şablon (15) Qbasic (14) php (14) online (13) Fotoğraf (12) Freeware (12) PHP script (12) Visual Basic (12) Kaynak kod (11) Dos (10) SolidWorks (10) ürünler (9) E-book (8) Photoshop (8) tutorial (6) Ders (5) Lisp (5) Word (5) Programlama (4)

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