Excel ve AutoCAD – Cennette Yaratılmış Uyum (3. Kısım)

Geçenlerde site üyelerimizden bir tanesi benden pencere çizimini VBA ile yaptırma konusunda benden yardım istedi. Bu site üyesinin bu yardımı isterken tam olarak neye ihtiyacı olduğunu bilmemekle birlikte; daha önce yayınlamış olduğum Excel ve AutoCAD – Cennette Yaratılmış Uyum (2. Kısım) isimli makalemde anlattıklarım üzerine biraz daha geliştirme yapmak suretiyle bu üyemizin ihtiyaçlarının kolaylıkla halledilebileceğini düşünüyorum. Ayrıca böylece sizlere VBA ile ilgili biraz daha katkım olacağı görüşündeyim. Aşağıda bulunan Pencere Çizdirme bağlantısına tıklamak suretiyle indirebileceğiniz Excel dosyası yardımıyla indirdiğiniz Excel dosyasının sırası ile A, B, C ve D sütunlarına gireceğiniz pencerenin enine ve yüksekliğine ait X,Y koordinatlarını kullanarak AutoCAD’in model alanına bir pencere çizdirebileceksiniz.

Bu kodu aşağıdaki bağlantıdan bilgisayarınıza indirebileceğiniz bir Excel dosyası içerisinde derlemeye karar verdim. Bu dosyada AutoCAD’in 2012 sürümünü referansladığımı özellikle belirtmeliyim. (VBA düzenleyicisi içerisinden Araçlar “ Tools” menüsü altında>Referanslar “References” komut düğmesi ile veya Excel’de Alt+F11 tuşlarını kullanmak suretiyle ulaşılabilir). Şayet kendi AutoCAD sürümünüzü referanslarsanız kod düzgün şekilde çalışacaktır.

Pencere_Cizdirme

Excel dosyası içerisine derlediğim kodu aşağıda da inceleme yapabilmeniz veya kendi VBA projenize kopyala yapabilmeniz için veriyorum. Tekrar belirtmeliyim ki, daha önce yayınlamış olduğum Excel ve AutoCAD – Cennette Yaratılmış Uyum (2. Kısım) isimli makalemde açıkladığım gibi kendi AutoCAD programınıza bağlantı yaratmanız gerekecektir.

12

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

Sub Main()Dim ACAD As AcadApplication 'Acad Uygulaması tipindeki ACAD değişkenini yaratır.

On Error Resume Next 'VBA’ya hataları ihmal etmesini (önemsememesini) söyler.

Set ACAD = GetObject(, "AutoCAD.Application") 'AutoCAD Uygulama sınıfının çalışan örneğine bağlantı kurar.

On Error GoTo 0 'Hataları ihmal etmemesi için, VBA’ya kodun en başına gitmesini söyler.

If ACAD Is Nothing Then 'Kodun buraya kadarki kısmının çalışıp çalışmadığını kontrol eder.

Set ACAD = New AcadApplication ' ACAD değişkenini AutoCAD’in yeni bir örneğine eşitler.

ACAD.Visible = True 'Yüklendiğinde, AutoCAD’i görünebilir olarak ayarlar.

End If

ACAD.ActiveDocument.Utility.Prompt "Excel’den Merhaba!" 'AutoCAD komut satırına "Excel’den Merhaba!"

‘mesajını yazar.

Dim Coords(7) As Double 'Noktaların koordinat değerlerinin depolandığı çift değişkenli dizidir.

Dim n As Integer 'Tam sayı tipindeki n değişkenini yaratır.

For n = 1 To 10 ' n değişkeninin değerini 1 den 10 a kadar birer birer arttıran döngü.

'En ve Yüksekliğin X, Y değişkenleri.

Dim X As Double

Dim Y As Double

Dim Width As Double

Dim Height As Double

'Değerleri Excel’den alarak hafızada depolama:

X = Sheet1.Cells(n, 1)

Y = Sheet1.Cells(n, 2)

Width = Sheet1.Cells(n, 3)

Height = Sheet1.Cells(n, 4)

'Sol alt Köşe

Coords(0) = X

Coords(1) = Y

'Sağ alt Köşe

Coords(2) = X + Width

Coords(3) = Y

'Sağ üst Köşe

Coords(4) = X + Width

Coords(5) = Y + Height

'Sol üst Köşe

Coords(6) = X

Coords(7) = Y + Height

'Sürekli çizgi “Polyline” tipinde bir değişken yaratma:

Dim PL As AcadLWPolyline

'Bu koordinatları kullanarak bir sürekli çizgi “polyline” yaratma

'(Karmaşık veri tipinde) bir referans nesne yaratıldığı zaman ifadeyi ayarlama.

'PL değişkeninin değeri yeni sürekli çizgimize “polyline” bir referans olacaktır.

Set PL = ACAD.ActiveDocument.ModelSpace.AddLightWeightPolyline(Coords)   ' AutoCAD’de bu pozisyona

 ‘bir nokta ekleme.

' PL değişkenini kapalı bir sürekli çizgi “polyline” yapma:

PL.Closed = True

Next

End Sub

Umarım yardımcı olabilmişimdir!