AutoCAD VBA #26. Çizgiye Nokta-2

Bu videoda Youtube kanalımda koni açınımları videolarında kullandığım çizgiye nokta VBA makrosunun geliştirilmesi açıklandı.
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.

Bu videoda makroya Uzunluk ve Çıkış seçenekleri eklendi.
Uzunluk seçeneği ile nokta konulacak mesafe değeri klavyeden girilebiliyor.
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.

Videoda kullanılan kodlar:

Sub CizgiyeNokta()
'Seçilen çizgi uzunluğu mesafesinde sonraki seçili çizgiye nokta ekler
'13/3/2022
'Mesut Akcan
'mesutakcan.blogspot.com

Dim cizgi1 As AcadEntity, cizgi2 As AcadLine
Dim p As AcadPoint
On Error Resume Next 'bir hata olursa sonraki satırdan devam et
Do
	With ThisDrawing.Utility
NESNE_SEC:
		Err.Clear 'hatayı temizle
		.InitializeUserInput 0, "Uzunluk Çıkış" 'kullanıcı girişini hazırla
		.GetEntity cizgi1, tn, vbLf & "Uzunluğu alınacak çizgiyi seç veya [Uzunluk/Çıkış]: "
		If Err Then 'hata varsa.
			'Seçeneklerden biri seçildiğinde 'User input is a keyword' hatası oluşur
			If Err.Description Like "*keyword*" Then 'hata açıklamasında keyword geçiyorsa
				secenek = .GetInput() 'seçeneği al
				Select Case secenek
					Case "Uzunluk" 'Uzunluk seçeneği seçildiyse
						.InitializeUserInput 1 + 2 'boş ve 0 değeri girişini engelle
						c1uz = .GetDistance(, vbLf & "Uzunluk:") 'uzunluk değerini gir
					Case "Çıkış" 'Çıkış seçeneği seçildiyse
						Exit Do 'döngüden çık
				End Select
			Else 'diğer hatalarda
				.Prompt vbLf & "*Nesne seçilmedi! Tekrar deneyin* "
				GoTo NESNE_SEC
			End If
		Else 'hata yoksa
			c1uz = cizgi1.Length '1. çizgi uzunluğu
			If Err Then 'Seçili nesnenin Length özelliği yoksa hata oluşur
				.Prompt vbLf & "*Geçerli nesne değil! Tekrar deneyin*"
				GoTo NESNE_SEC
			End If
			cizgi1.Highlight True 'seçili çizgiyi vurgulu yap
		End If
		Err.Clear 'hatayı temizle
		.GetEntity cizgi2, tn, vbCr & "Nokta konulacak çizgi:"
		'çizgi nesnesi haricinde hata oluşur
		If Err Then Exit Do 'döngüden çık
		c2uz = cizgi2.Length '2. çizgi uzunluğu
		uzSp = Uzaklik(cizgi2.StartPoint, tn) 'tıklanan noktadan başlangıç noktasına uzaklık
		uzEp = Uzaklik(cizgi2.EndPoint, tn) 'tıklanan noktadan bitiş noktasına uzaklık
		If uzEp < uzSp Then c1uz = c2uz - c1uz 'tıklanan nokta bitiş noktasına yakınsa
		Set p = ThisDrawing.ModelSpace.AddPoint( _
			.PolarPoint(cizgi2.StartPoint, cizgi2.Angle, c1uz))
		p.Layer = "Nokta"
	End With
Loop
ThisDrawing.Regen acAllViewports 'çizimleri yenile
End Sub

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

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