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

AutoCAD ile VBA Makro Kullanımı #6-2

Sub PolarPoint_1()
    ' .GetPoint([nokta] , [mesaj])
    ' Tıklanan Noktanın koordinat değerleri alınır. X,Y,Z
    
    ' .PolarPoint(Nokta , Açı , Uzunluk)
    ' Belirlenen noktanın verilen açı ve mesafedeki konumunu verir
    
    ' .AddText(Yazı , EklemeNoktası , YazıYüksekliği)
    ' Yazı yazdırır
    
    ' Açı(Rad) = Açı(Derece) * pi / 180
    ' Derece --> Radyan dönüşümü
    
    ' .AddLine(BaşlamaNoktası , BitişNoktası)
    ' Belirlenen 2 nokta arasına çizgi çizer
    
    ' Regen acActiveViewport
    ' Çizimi yeniden oluşturur
    pi = 4 * Atn(1) '3.14...
    a = 60 'açı - derece
    a = a * pi / 180 'açı - radyan
    With ThisDrawing.Utility
        n1 = .GetPoint(, "Nokta:")
        pp = .PolarPoint(n1, a, 50)
        ModelSpace.AddLine n1, pp
    End With
End Sub

Sub PolarPoint_1()
    With ThisDrawing.Utility
        pi = 4 * Atn(1)
        n1 = .GetPoint(, "Nokta:")
        For n = 0 To 359 Step 20
            a = n * pi / 180 'açı - radyan
            r = .PolarPoint(n1, a, 50)
            Set y = ModelSpace.AddText(n & "°", r, 3)
            y.color = acGreen
            Set c = ModelSpace.AddLine(n1, r)
        Next
    End With
End Sub

Sub PolarPoint_1()
    With ThisDrawing.Utility
        pi = 4 * Atn(1)
        n1 = .GetPoint(, "Nokta:")
        For n = 0 To 359
            a = n * pi / 180 'açı - radyan
            r = .PolarPoint(n1, a, 50)
            'Set y = ModelSpace.AddText(n & "°", r, 3)
            'y.color = acGreen
            Set c = ModelSpace.AddLine(n1, r)
            c.color = n * 0.7
        Next
    End With
End Sub

Sub YayCiz()
    ' .GetPoint([nokta] , [mesaj])
    ' Tıklanan Noktanın koordinat değerleri alınır. X,Y,Z
    
    ' .GetDistance([nokta] , [mesaj])
    ' Tıklanan iki noktanın mesafesi alınır. Değer girilebilir.
    
    ' .AngleFromXAxis(BaşlamaNoktası , BitişNoktası)
    ' Belirlenen 2 noktanın X ekseindeki açısı
    
    ' .AddArc(MerkezNokta , Yarıçap , Başl.Açısı , BitişAçısı)
    ' Yay çizer
    Dim yay As AcadArc
    With Utility
        m = .GetPoint(, "Merkez nokta: ")
        r = .GetDistance(m, "Yarıçap:")
        p1 = .GetPoint(m, "Başlangıç noktası")
        p2 = .GetPoint(m, "Bitiş noktası")
        a1 = .AngleFromXAxis(m, p1) 'radyan
        a2 = .AngleFromXAxis(m, p2) 'radyan
    End With
    Set yay = ModelSpace.AddArc(m, r, a1, a2)
End Sub