25 Şubat 2018 Pazar

AutoCAD ile VBA makro kullanımı #2


AutoCAD VBA makro kullanımı hakkında temel bilgileriniz yoksa konuyla ilgili bir önceki yazımı okumanızı tavsiye ederim.

Bir önceki yazıda "VBA kodları ile belirtilen noktaya eksen çizgileri çizen kodları" yazacağımı belirtmiştim.

İşte bu yazıda bunun nasıl yapıldığını göreceğiz.
  • AutoCAD'i açın
  • ALT+F11 ile VBA editörünü açın
  • Sol bölmeden ThisDrawing'i çift tıklayın sağ bölmede kod bölmesi açılacak.
  • Kod bölmesine aşağıdaki VBA kodu ekleyin.
Sub eksen()
	Dim c As AcadLine
	With ThisDrawing.Utility
		nokta = .GetPoint(, "Merkez noktası belirt.")
		uz = .GetDistance(nokta, "Kol uzunluğu gir")
		uz = uz * 2
	End With
	n1 = nokta
	n2 = nokta
	n1(0) = nokta(0) - uz / 2
	n2(0) = nokta(0) + uz / 2
	Set c = ThisDrawing.Application.ActiveDocument.ModelSpace.AddLine(n1, n2)
	n1 = nokta
	n2 = nokta
	n1(1) = nokta(1) - uz / 2
	n2(1) = nokta(1) + uz / 2
	Set c = ThisDrawing.Application.ActiveDocument.ModelSpace.AddLine(n1, n2)
End Sub
AutoCAD penceresine geçin.

Kodları çalıştırmak için 3 farklı yol var.
1) Klavyeden ALT+F8,
2) Komut satırından VBARUN,
3) Ribbon menüden Manage / Applications / Run VBA Macro

Kodlar çalıştığında "Merkez Noktası belirt." mesajıyla merkez noktası istenecek. Fare ile konum tıklanacağı gibi klavyeden koordinat da girilebilir. 200,250 gibi
Sonraki aşamada Kol uzunluğunu gir mesajıyla eksenin bir kol uzunluğu girilir ya da fare ile açıklık belirtilir.

Komut sonlandığında belirtilen konuma verilen kol uzunluğu kadar + (eksen) çizgileri çizilir.
Evet, bu eksen çiziminde bir sorun var. Eksen düz çizgiyle çizilmiş. Kodları çalıştırmadan önce çizgi tiplerinden eksen çizgisi seçilirse eksen kesik noktalı çizgiyle çizilir. Ama bu işlemi kodlarla da yapabiliriz.

Kod alanında kodların tamamını silip aşağıdaki kodları ekleyin.
Sub eksen()
	'makro Mesut Akcan, mesutakcan.blogspot.com 02/03/2017
	On Error Resume Next
	Dim al As AcadLine
	With ThisDrawing
		.Linetypes.Load "ACAD_ISO10W100", "acad.lin"
		.ActiveLinetype = ThisDrawing.Linetypes.Item("ACAD_ISO10W100")
		With .Utility
			nokta = .GetPoint(, "Merkez noktası belirt.")
			uz = .GetDistance(nokta, "Kol uzunluğu gir.")
			uz = uz * 2
		End With
	End With
	With ThisDrawing.Application.ActiveDocument.ModelSpace
		n1 = nokta
		n2 = nokta
		n1(0) = nokta(0) - uz / 2
		n2(0) = nokta(0) + uz / 2
		Set al = .AddLine(n1, n2)
		n1 = nokta
		n2 = nokta
		n1(1) = nokta(1) - uz / 2
		n2(1) = nokta(1) + uz / 2
		Set al = .AddLine(n1, n2)
	End With
End Sub
Artık üstteki resimde görüldüğü gibi eksen çizgisi ile eksen çizilecek.
Komuttan çıkıldığında tekrar düz çizgi otomatik seçilsin isterseniz End Sub Satırından önce aşağıdaki satırı ekleyin.
ThisDrawing.ActiveLinetype = ThisDrawing.Linetypes.Item("Continuous")

Kodların biraz daha düzenlemiş hali (güncelleme):
Sub EksenCiz()
	'makro Mesut Akcan, mesutakcan.blogspot.com 17/03/2018
	On Error Resume Next
	Linetypes.Load "ACAD_ISO10W100", "acad.lin"
	ActiveLinetype = Linetypes.Item("ACAD_ISO10W100")
	merkeznokta = Utility.GetPoint(, "Merkez noktasını giriniz") 'X,Y,Z
	'merkeznokta(0) ->X
	'merkeznokta(1) ->Y
	'merkeznokta(2) ->Z
	uzunluk = Utility.GetDistance(merkeznokta, "Kol uzunluğunu giriniz")
	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

Hiç yorum yok:

Yorum Gönder