AutoCAD VBA. Excele veri yaz-3

VBA kodlarıyla ofis programlarına bağlantı kurulabilir ve programla ilgili birçok işlem yaptırılabilir.

AutoCAD VBA'dan Excel'e bağlantı kurulabildiği gibi tersi de mümkündür

Hatta birçok uyumlu Windows programı birbiri ile bağlanıp kodlarla işlemler yapabilir.

Bu videoda AutoCAD VBA ile Excel'e bağlanmayı ve veri aktarmayı göstermeye devam ediyorum.

• Excele sayfa ekle
• Excel sayfası silme
• AutoCAD çizim nesne adlarını Excele yaz
• AutoCAD çizim alanındaki çizgilerin uzunluklarını ve toplamını Excele yaz
• Excel dosyasını aç

Videoda kullanılan VBA kodları:

'Mesut Akcan
'https://mesutakcan.blogspot.com
'https://youtube.com/mesutakcan
'makcan@gmail.com

Sub excelDosyaAc2()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'Excel uygulamasını temsil eden nesne
	Dim wb As Excel.Workbook 'Excel çalışma kitabını temsil eden nesne

	Set xla = Excel.Application
	xla.Visible = True  'uygulamayı ekranda göster

	Set wb = xla.Workbooks.Open("c:\test\test2.xlsx") 'dosyayı excel ile aç
End Sub

Sub excelDosyaAc1()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
	xla.Visible = True 'ekranda excel nesnesini göster

	Dim dosya As Excel.Workbook 'excel çalışma kitabı nesnesi
	Set dosya = xla.Workbooks.Open("c:\test\test1.xlsx") 'dosyayı excel ile aç
End Sub

Sub exceleYaz6()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar

	xla.Workbooks.Add 'Yeni dosya oluştur.
	xla.Visible = True 'ekranda excel nesnesini göster
   
	Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
	Set sayfa = xla.ActiveSheet
	sayfa.Name = "Liste"

	Dim ent As AcadEntity 'AutoCad Varlık

	For Each ent In ThisDrawing.ModelSpace 'Çizim alanındaki tüm varlıklar
		If ent.ObjectName = "AcDbLine" Then
			satir = satir + 1
			uz = ent.Length
			sayfa.Cells(satir, 2) = uz
			toplamUzunluk = toplamUzunluk + uz
		End If
	Next

	sayfa.Cells(satir + 1, 1).Value = "TOPLAM:"
	sayfa.Cells(satir + 1, 2).Value = toplamUzunluk
	sayfa.Cells(satir + 1, 2).Font.color = vbRed

	sayfa.SaveAs "c:\TEST\test2.xlsx" 'Dosyaya kaydet
End Sub

Sub exceleYaz5()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar

	xla.Workbooks.Add 'Yeni dosya oluştur.
	xla.Visible = True 'ekranda excel nesnesini göster
   
	Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
	'Son sayfadan sonra ekle
	Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(xla.Worksheets.Count))
	sayfa.Name = "TEST"

	Dim ent As AcadEntity 'AutoCad Varlık

	For Each ent In ThisDrawing.ModelSpace 'Çizim alanındaki tüm varlıklar
		satir = satir + 1 'satır numarasını 1 arttır
		sayfa.Cells(satir, 1).Value = ent.ObjectName 'hücreye nesne adını yaz
	Next
	sayfa.SaveAs "c:\TEST\test1.xlsx" 'Dosyaya kaydet
End Sub

Sub exceleYaz4()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar

	xla.Workbooks.Add 'Yeni dosya oluştur.
	xla.Visible = True 'ekranda excel nesnesini göster
   
	Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
	'Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(xla.Worksheets.Count)) 'Son sayfadan sonra yeni sayfa ekle

	'2. sayfadan sonra ekle
	Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets(2))
	sayfa.Name = "TEST"

	'TEST sayfasından sonra ekle
	Set sayfa = xla.Worksheets.Add(After:=xla.Worksheets("TEST"))
	sayfa.Name = "DENEME"

	'TEST sayfasından önce ekle
	Set sayfa = xla.Worksheets.Add(Before:=xla.Worksheets("TEST"))
	sayfa.Name = "HESAP"

	sayfa.Delete

	Set sayfa = xla.Worksheets("TEST")
	sayfa.Delete 'sayfa sil

	xla.Worksheets("DENEME").Delete 'sayfa sil
End Sub

Sub exceleYaz3()
	'2. yöntem: Geç bağlanma. Late Binding

	Dim xla As Object 'nesne için değişken tanımla
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
	xla.Visible = True 'ekranda excel nesnesini göster

	Dim wb As Object 'nesne için değişken tanımla
	Set wb = xla.Workbooks.Add 'Yeni dosya oluştur.

	Dim sayfa As Object 'nesne için değişken tanımla
	Set sayfa = wb.Worksheets.Add 'yeni dosya oluştur
	sayfa.Name = "TEST" 'sayfa adını değiştir.
	sayfa.Cells(4, 3) = "Merhaba" 'satır 4, sütun 3'e Merhaba yaz
End Sub

Sub exceleYaz2()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
	xla.Workbooks.Add 'Yeni dosya oluştur.
	xla.Visible = True 'ekranda excel nesnesini göster

	'xla.Worksheets.Add 'yeni excel sayfası ekle

	Dim sayfa As Excel.Worksheet 'excel sayfası nesnesi
	Set sayfa = xla.Worksheets.Add 'yeni excel sayfası ekle

	sayfa.Name = "TEST" 'sayfa adını değiştir

	Set sayfa = xla.Worksheets(2) 'excel 2. sayfa
	sayfa.Activate 'sayfayı aktif et

	With sayfa.Range("B3")
		.Value = "Merhaba" 'Satır 3, Sütun 2'ye Merhaba yaz
		.Interior.color = vbRed 'zemin rengi kırmızı
		.Font.color = vbWhite 'yazı rengi beyaz
		.Font.Bold = True 'kalın yazı
		'.Select 'B3 hücresini seç
	End With
End Sub

Sub exceleYaz1()
	'1. yöntem: Erken bağlanma. Early Binding
	'Tools / References / Microsoft Excel xx.x Object Library ekle

	Dim xla As Excel.Application 'excel uygulamasını örnek alan nesne oluştur
	Set xla = CreateObject("Excel.Application") 'excel nesnesi oluşturup değişkene aktar
	xla.Workbooks.Add 'Yeni dosya oluştur.
	xla.Visible = True 'ekranda excel nesnesini göster

	With xla.Application.Range("B3")
		.Value = "Merhaba" 'Satır 3, Sütun 2'ye Merhaba yaz
		.Interior.color = vbRed 'zemin rengi kırmızı
		.Font.color = vbWhite 'yazı rengi beyaz
		.Font.Bold = True 'kalın yazı
		.Select 'B3 hücresini seç
	End With
	xla.Quit 'Exceli kapat
End Sub

AutoLisp ile nesne uzunluğunu nesne üzerine yazma

AutoCAD kullanıcıları çizimlerde nesnelerin uzunluğunu sıklıkla hesaplama durumunda kalır. Bu işlemi manuel olarak yapmak zaman alıcı ve hata yapmaya açık olabilir. Neyse ki, AutoLISP programlama dili ile bu sürec otomatikleştirilebilir.

Aşağıdaki AutoLisp kodları, AutoCAD'de bir nesnenin uzunluğunu hesaplayıp ve sonucu bir metin nesnesi olarak çizimim üzerine ekler.

Bu kod parçacığı, kullanıcının seçtiği geçerli bir nesnenin uzunluğunu hesaplar ve bu uzunluğu bir metin nesnesi olarak çizime ekler.

; Nesne uzuluğu, nesne üzerinde bir konuma eklenir
; Seçilebilecek geçerli nesneler:
; LINE, POLYLINE, LWPOLYLINE, ARC, CIRCLE, ELLIPSE, SPLINE

; AutoCAD komut satırından UY ya da UZUNLUKYAZ
; girilerek çalıştırılır.

; Düzenleme: Mesut Akcan
; makcan@gmail.com
; mesutakcan.blogspot.com
; 14/07/2023

(vl-load-com)
(defun c:UY()
	(c:UZUNLUKYAZ)
)
(defun c:UZUNLUKYAZ( / aci bpt cb2 cercevegenisligi
										cerceveyuksekligi cpt ent gr mpt
										pib2 pt1 pt2 pt3 pt4 spt tpt
										uzunluk yazicerceve) 
	(if (and
		; Kullanıcıdan nesne seçimi alınır ve ent değişkenine atanır
		; Nesne seçiliyse
		(setq ent (car (entsel "\nUzunluğu alınacak nesne: ")))
		; VE
		; seçili nesne
		; LINE, POLYLINE, LWPOLYLINE, ARC,
		; CIRCLE, ELLIPSE, SPLINE ise
		(member (cdr (assoc 0 (entget ent)))
				'("LINE" "POLYLINE" "LWPOLYLINE"
				  "ARC" "CIRCLE" "ELLIPSE" "SPLINE"))
		)
		(progn
			(setq
				; Seçilen nesnenin uzunluğu hesaplanır ve uzunluk değişkenine atanır
				uzunluk (rtos (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))) 
				; Metin nesnesini ölçer ve metni çevreleyen çerçevenin köşegen koordinatlarını
				; yaziCerceve değişkenine atanır
				yaziCerceve (textbox (list (cons 1 uzunluk) (cons 40 (getvar "TEXTSIZE"))))
				; Yazı çerçevesi yüksekliği hesaplanır ve cerceveYuksekligi değişkenine atanır
				cerceveYuksekligi (- (cadadr yaziCerceve) (cadar yaziCerceve))
				; Yazı çerçevesi genişliği hesaplanır ve cerceveGenisligi değişkenine atanır
				cerceveGenisligi (- (caadr yaziCerceve) (caar yaziCerceve))
			) 
			(princ "\nYazı konumu") 
			; Kullanıcıdan nokta seçimi istenir
			(while (eq 5 (car (setq gr (grread t 5 0)))) 
				(redraw)
				; Seçilen noktanın bir liste olduğu kontrol edilir. Eğer nokta ise
				(if (listp (setq sPt (cadr gr))) 
					(progn
						(setq
							; Seçilen noktaya en yakın nokta
							cPt (vlax-curve-getClosestPointto ent sPt)
							; İki nokta arasındaki açı
							aci (angle cPt sPt)
							; Başlangıç noktası
							bPt (polar cPt aci (/ (getvar "TEXTSIZE") 2.))
							; Bitiş noktası
							tPt (polar bPt aci cerceveYuksekligi)
							; Orta nokta
							mPt (polar bPt aci (/ cerceveYuksekligi 2.))
							pib2 (/ pi 2.) ; pi/2
							cb2 (/ cerceveGenisligi 2.) ; cerceveGenisligi/2
							; Köşe noktaları
							pt1 (polar bPt (+ aci pib2) cb2)
							pt2 (polar bPt (- aci pib2) cb2)
							pt3 (polar tPt (+ aci pib2) cb2)
							pt4 (polar tPt (- aci pib2) cb2)
						)
						; İşaretleyici vektörler çizilir
						(grvecs (list -3 pt1 pt2 pt3 pt4 pt1 pt3 pt2 pt4))
					)
				)
			)
			(if (eq 3 (car gr)) ; Konum belirlendiyse. Fare ile tıklama 
				(progn
					; açı= açı - 90°
					(setq aci (- aci (/ pi 2.)))
					(cond
						; açı 90 - 180 arası ise açı = açı - 180°
						((and (> aci (/ pi 2.)) (<= aci pi)) (setq aci (- aci pi)))
						; açı 180 - 270 arası ise açı = açı + 180°
						((and (> aci pi) (<= aci (* 1.5 pi))) (setq aci (+ aci pi)))
					)
				  ; Yazı oluşturulur ve çizime eklenir
					(YaziYaz mPt uzunluk aci)
					)
			 )
		)
		; Geçersiz bir nesne seçildiyse
		(princ "\nGeçersiz nesne seçildi !")
	)
	(redraw) ; Çizimi yenile
	(princ)
)

(defun YaziYaz (konum yaziMetni yaziAcisi)
	(entmake
		(list
			(cons 0 "TEXT") ; Nesne türü (Text)
			(cons 8 (getvar "CLAYER")) ; Katman adı
			(cons 62 2) ; Renk indeksi. 2=Sarı renk
			(cons 10 konum) ; Yazı konumu (nokta)
			(cons 40 (getvar "TEXTSIZE")) ; Yazı boyutu
			(cons 1 yaziMetni) ; Yazı içeriği
			(cons 50 yaziAcisi) ; Yazı döndürme açısı
			(cons 7 (getvar "TEXTSTYLE")) ; Yazı stili
			(cons 71 0) ; 71: İç hizalama (0: Sol)
			(cons 72 1) ; 72: Dış hizalama (1: Alt)
			(cons 73 2) ; 73: Hizalama tipi (2: Ortala)
			(cons 11 konum) ; 11: İkinci nokta (hizalama için kullanılır)
		)
	)
)

İşleyişi:

1. Kullanıcıdan bir nesne seçimi alınır ve seçilen nesne doğruluk kontrolü yapılır.
2. Eğer seçilen nesne geçerli bir nesne ise, uzunluğu hesaplanır ve bir metin nesnesi oluşturulur.
3. Metin nesnesinin konumu kullanıcıdan alınır.
4. Metin nesnesi çizime eklenir ve kullanıcıya sonuç gösterilir.

Kullanımı:

Kodları kopyalayıp uzunlukyaz.lsp adında metin dosyasına ekleyip kaydediniz.