AutoCAD VBA #25. Çizgiye Nokta-1

Youtube kanlımda koni açınımlarında kullandığım çizgiye nokta VBA makrosu.

Makro çalıştırıldığında bir çizgi seçilerek çizginin uzunluğu alınır. Sonra bir çizgi daha seçilir 2. seçilen çizgiye 1. çizgi uzunluğu mesafesinde nokta konulur. MEASURE komutunun işlevine biraz benzer.

CizgiyeNokta makrosunu komut satırından çalıştırmak için Autocad'de CN komutu oluşturulur. CN komutunu oluşturmak için CN_komutu prosedürünün bir kere çalıştırılması yeterlidir.

Makro kodları:

Sub CizgiyeNokta()
'Seçilen çizgi uzunluğu mesafesinde sonraki seçili çizgiye nokta ekler
'Mesut Akcan
'mesutakcan.blogSpot.com
'14/02/2022
Dim cizgi1 As AcadEntity, cizgi2 As AcadEntity
Dim p As AcadPoint
On Error GoTo hata
Do
	With ThisDrawing.Utility
		.GetEntity cizgi1, tn, vbCr & "Uzunluğu alınacak çizgi:"
		cizgi1.color = 252 'gri
		c1uz = cizgi1.Length '1. çizgi uzunluğu
		.GetEntity cizgi2, tn, vbCr & "Nokta konulacak çizgi:"
		c2uz = cizgi2.Length '2. çizgi uzunluğu
        'tıklanan noktadan başlangıç noktasına uzaklık
		uzSp = Uzaklik(cizgi2.StartPoint, tn)
        'tıklanan noktadan bitiş noktasına uzaklık
		uzEp = Uzaklik(cizgi2.EndPoint, tn)
        'tıklanan nokta bitiş noktasına yakınsa
		If uzEp < uzSp Then c1uz = c2uz - c1uz 
		Set p = ThisDrawing.ModelSpace.AddPoint _
		  (.PolarPoint(cizgi2.StartPoint, cizgi2.Angle, c1uz))
		p.Layer = "Nokta"
	End With
Loop
hata:
End Sub

'iki nokta arası mesafe
Function Uzaklik(p1, p2) As Double
	Uzaklik = Sqr((p1(0) - p2(0)) ^ 2 + (p1(1) - p2(1)) ^ 2)
End Function

'AutoCADe CN komutunu ekler
Sub CN_komutu()
	ThisDrawing.SendCommand "(defun c:CN() (command ""-VBARUN"" ""CizgiyeNokta"")(princ))" & vbCr
End Sub