AutoCAD ile VBA Makro Kullanımı #3

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 mesutakcan.blogspot.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 mesutakcan.blogspot.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 mesutakcan.blogspot.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 mesutakcan.blogspot.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 mesutakcan.blogspot.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 mesutakcan.blogspot.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 mesutakcan.blogspot.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