AutoCAD VBA ile dikdörtgen çiz

AutoCAD ile VBA kullanarak dikdörtgen çizme işlemi oldukça basit ve verimlidir. AutoCAD VBA'yı kullanmak için öncelikle AutoCAD'in yüklü olması ve VBA'ın etkinleştirilmiş olması gerekmektedir.

Konu ile ilgili ayrıntılı bilgiler: https://mesutakcan.blogspot.com/2017/12/autocad-ile-vba-makro-kullanm-1.html

İşlem basamakları:

• AutoCAD'i açın.
• ALT+F11 ile VBA kod editörünü açın.
• Menüden Insert  / Module tıklayın.
• Açılan Module1 kod sayfasına aşağıdaki kodları ekleyin.

'Dikdörgen çizen prosedür
'Mesut Akcan
'31/10/2023
'makcan@gmail.com

'Blog sayfam     : https://mesutakcan.blogSpot.com
'Youtube Kanalım : https://www.youtube.com/mesutakcan
'WhatsApp kanalım: https://www.whatsapp.com/channel/0029Va5h4cQ0LKZLuB9Dpy23
'Telegram kanalım: https://t.me/mesutakcan

Public Sub dikDortgenCiz(p As Variant, genislik As Double, yukseklik As Double, _
	Optional dondurmeAcisi As Double = 0, Optional yuvarlatmaYariCapi As Double = 0, _
	Optional polyLine As Boolean = True)
    
    'köşe noktaları. X
	Dim x1 As Double, x2 As Double, x3 As Double, x4 As Double 
    'köşe noktaları. Y
	Dim y1 As Double, y2 As Double, y3 As Double, y4 As Double

	Dim vl As Variant 'vertex listesi
	Dim util As Object 'nesne tanımla
	Dim pl As AcadLWPolyline 'Polyline nesnesi

	Set util = ThisDrawing.Utility 'utility nesnesi
	
	' Köşe noktalarının X değerleri
	x1 = p(0)
	x2 = x1 + yuvarlatmaYariCapi
	x4 = x1 + genislik
	x3 = x4 - yuvarlatmaYariCapi
	
	' Köşe noktalarının Y değerleri
	y1 = p(1)
	y2 = p(1) + yuvarlatmaYariCapi
	y4 = p(1) + yukseklik
	y3 = y4 - yuvarlatmaYariCapi
	
	If yuvarlatmaYariCapi > 0 Then 'dikdörtgen köşelerinde yuvarlatma yapılacaksa
		'vl dizi değişkenine köşe(vertex) noktalarını aktar
		util.CreateTypedArray vl, vbDouble, x2, y1, x3, y1, x4, y2, x4, y3, x3, y4, _
			x2, y4, x1, y3, x1, y2
	Else 'yuvarlatma yapılmayacaksa
		'vl dizi değişkenine vertex noktalarını aktar
		util.CreateTypedArray vl, vbDouble, x1, y1, x4, y1, x4, y4, x1, y4
	End If
	
	'polyline dikdörtgeni çiz
	Set pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(vl)
	pl.Closed = True 'kapalı şekil
	
	'bulge değeri: Tanjant(Yuvarlatlacak vertek noktalarının gördüğü açı / 4)
	'bulge değeri = Tanjant(Açı/4) => Açı=90° => pi/2
	' =Tan(90°/4) => Tan((pi/2)/4) => Tan(pi / 8)
	Const bd As Double = 0.414213562373095  ' Tan(pi / 8)
	
	'dikdörten köşelerinde yuvarlatma yapılacaksa
	If yuvarlatmaYariCapi > 0 Then
		pl.SetBulge 1, bd
		pl.SetBulge 3, bd
		pl.SetBulge 5, bd
		pl.SetBulge 7, bd
	End If

	'dikdörtgen döndürülecekse
	If dondurmeAcisi > 0 Then
		Const pi As Double = 3.14159265358979 'pi sabiti
		pl.Rotate p, dondurmeAcisi * (pi / 180)
	End If

	'Dikdörtgen çizgi ve yay ile çizilecekse çizimi patlat
	If polyLine = False Then pl.Explode
End Sub

Dikdörtgençiz prosedürünü kullanmak için örnek

• Aşağıdaki kodları ThisDrawing kod sayfasına ekleyin.
• VBA editöründe çalıştırmak için F5
• AutoCAD ekranında çalıştırmak için ALT+F8

Sub dikDortgenCizOrnekKullanim()
	n = ThisDrawing.Utility.GetPoint(, "Dikdörtgen sol alt köşe noktası:")
	Call dikDortgenCiz(n, 30, 20)
	Call dikDortgenCiz(n, 50, 30, 5)
	Call dikDortgenCiz(n, 60, 35, 15, 10)
	Call dikDortgenCiz(n, 80, 45, 25, 12, False)
End Sub