Etiketler

AutoCAD (60) 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) Şablon (15) Qbasic (14) php (14) online (13) Fotoğraf (12) Freeware (12) PHP script (12) VBA (12) Visual Basic (12) Kaynak kod (11) Dos (10) SolidWorks (10) ürünler (9) E-book (8) Photoshop (8) tutorial (6) Ders (5) Word (5) Lisp (4) Programlama (4)

Youtube Kanalıma Abone Olunuz

YouTube kanalımın 1000 aboneye ulaşması için takip etmeseniz bile Lütfen Abone olunuz.

www.youtube.com/mesutakcan

18 Haziran 2019 Salı

AutoCAD ile VBA Makro kullanımı #4-1

Bu yazıyı 2 bölüm halinde hazırladım.
Bir önceki yazımda kullandığım eksen çizen VBA kodları geliştireceğim.
Eski kodlarda yapacağım iyileştirmelerde şunlar olacak
  • Eksen için daire veya yay seçilebilecek
  • Farklı nesne seçildiyse çizim yapılmayıp mesaj ile çıkılacak
  • Eksen katmanı yoksa eksen katmanı eklenecek
  • Katman ayarları yapılacak
  • Aktif katman "Eksen" olacak
  • "Eksen" katmanına eksen çizgileri çizilecek
  • Bir önceki katman, aktif katman olacak

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Sub EksenCiz()
'AutoCAD ile VBA Makro kullanımı #4
'Autocad VBA ile Daire ya da yaylara eksen çizme:

' Kodların kullanımı ile ilgili video:
' https://www.youtube.com/watch?v=nph7BM3kQbQ

' AutoCAD ile VBA Makro kullanımı playlist:
' https://www.youtube.com/playlist?list=PLte7FEGCpudNwNr71-FhUS1g3FAhnNPjD

' Makro kodu: Mesut Akcan
' 18/6/2019
' Güncelleme: 15/8/2019

' www.akcansoft.com
' makcan@gmail.com
' ------------------------------------------------------------
' Daire ya da yaylara VBA ile eksen çizen kodları geliştirme
' Eksen için daire veya yay seçilebilecek
' Farklı nesne seçildiyse çizim yapılmayıp mesaj ile çıkılacak
' Eksen katmanı yoksa eksen katmanı eklenecek
' Katman ayarları yapılacak
' Aktif katman "Eksen" olacak
' "Eksen" katmanına eksen çizgileri çizilecek
' Bir önceki katman aktif katman olacak
' ------------------------------------------------------------
Dim cizgi As AcadLine, nesne As AcadObject
Dim nkt As Variant, uzunluk As Double
Dim merkezNokta As Variant, n1 As Variant, n2 As Variant
Dim eksenKatman As AcadLayer
Dim aktifKatman As AcadLayer

On Error Resume Next ' Hata olursa sonraki satırdan devam eder
Utility.GetEntity nesne, nkt, "Eksen çizilecek daire ya da yayı seçiniz: "
If nesne Is Nothing Then
    Utility.Prompt "Herhangi bir nesne seçilmedi!"
    Exit Sub
End If
    
If (TypeOf nesne Is AcadCircle) Or (TypeOf nesne Is AcadArc) Then

    Linetypes.Load "CENTER", "acad.lin"
    Set aktifKatman = ActiveLayer

    Set eksenKatman = Layers.Item("Eksen")
    'If Err.Number = -2145386476 Then
    If eksenKatman Is Nothing Then ' eksen katmanı yoksa
        Set eksenKatman = Layers.Add("Eksen")
        eksenKatman.color = acCyan
        eksenKatman.Linetype = "CENTER"
    End If
    On Error GoTo 0
    ActiveLayer = eksenKatman

    merkezNokta = nesne.Center
    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)
    With cizgi
        .Linetype = "ByLayer"
        .color = acByLayer
        .Lineweight = acLnWtByLayer
    End With
        
    n1 = merkezNokta
    n2 = merkezNokta
    
    n1(1) = merkezNokta(1) - uzunluk 'Y
    n2(1) = merkezNokta(1) + uzunluk 'Y
    
    Set cizgi = ModelSpace.AddLine(n1, n2)
    With cizgi
        .Linetype = "ByLayer"
        .color = acByLayer
        .Lineweight = acLnWtByLayer
    End With
    
    ActiveLayer = aktifKatman
Else
    Utility.Prompt "Seçilen nesne daire ya da yay değil!"
End If
End Sub


İlgili video:


AutoCAD ile VBA Makro kullanımı playlist:
https://www.youtube.com/playlist?list=PLte7FEGCpudNwNr71-FhUS1g3FAhnNPjD

Sonraki bölüm için tıklayınız.

Hiç yorum yok:

Yorum Gönder

Related Posts Plugin for WordPress, Blogger...