Buradaki Program özellikle Totalstation kullananlar için ,tabii başka amaçlar içinde kullanılabilir. Totalstationdan Autocad'e nokta aktarınca iki boyutlu çalıştığınız zaman noktaların numarasını bazen göremiyorsunuz. Numaralar size yatay duruyor. İşte Bu noktaları döndürmek için bu programı yazdım. Bu program tüm InsertionPoint noktası olan nesneleri kendi ekseni etrafında döndürüyor.

kodu
Public Sub Dondur() Dim objSelSet As AcadSelectionSet Dim objDrawingObject As AcadEntity On Error Resume Next ThisDrawing.SelectionSets("tmp").Delete Set objSelSet = ThisDrawing.SelectionSets.Add("tmp") objSelSet.SelectOnScreen Dim a As Variant Dim b As Variant Dim aci As Double Dim f(0 To 2) As Double Dim nokta2(0 To 2) As Double a = ThisDrawing.Utility.GetPoint(, "Birinci noktayı Gir: ") b = ThisDrawing.Utility.GetPoint(, "İkinci noktayı Gir: ") aci = ThisDrawing.Utility.GetAngle(, "Açıyı Gir: ") f(0) = a(0) - b(0) f(1) = a(1) - b(1) f(2) = a(2) - b(2) For Each objDrawingObject In objSelSet nokta = objDrawingObject.InsertionPoint nokta2(0) = nokta(0) - f(0) nokta2(1) = nokta(1) - f(1) nokta2(2) = nokta(2) - f(2) 'If StrComp(objDrawingObject.ObjectName, "AcDbBlockRefence") Then objDrawingObject.Rotate3D nokta, nokta2, aci objDrawingObject.Update 'End If Next objSelSet.Delete End Sub

ÇALIŞTIRMASI NASIL ?

1-) Kodu kopyalayın ve autocad'den
----Tools
----Makro
----Visual Basic Editor
----ThisDrawing veya çiziminizin adı (iki kere Tıkla)
----Kodu yapıştır.(ctrl+v)
----autocade dön


daha sonra

----autocade dönüp 'vbarun' yazın
----dondur fonksiyonunu seçin
----run 'a basın
----nesneleri seçin
----döndüreceğiniz eksenin birinci noktasını seçin
----döndüreceğiniz eksenin ikinci noktasını seçin
----açıyı yazıp döndürün,genelde 90 oluyor.



isterseniz bu programı dondurme.dvb uzantılı dosya olarak kaydedin(Autocad kapanırken soruyor)

----autocadden komutsatırına (vbaload) yazın
----Dondurme.dvb dosyasını seçin
----artık tekrar tekrar kod yapıştırmanıza gerek yok.
programı bir vba editore geçirdikten veya (vbaload) komutuyla yükledikten sonra bir daha yüklemenize gerek yok.Tabi Autocadı tekrar açtığınızda bu işlemi yeniden yapmak zorundasınız.

   Ümit Kekeç          umitk2001@yahoo.com