ExcelToAutoCAD

Excel den AutoCAD e Koordinatların aktarılması
Excel2AutoCAD

Merhaba,

Excel dosyasın da bulunan Koordinatları
AutoCAD e otomatik olarak aktarmaya yarar.

Genelde Haritacı arkadaşların işine yaramaktadır
Kodlar Excel VBA da yazılmıştır ve
Excel Eklentisine (XLA) dönüştürülmüştür.
Not: VBA kodları açıktır inceleye bilirsiniz.

Bu Dosya sayesinde Excel in En üste ki Ana Menüsünün En sağına
AutoCad menusu ekleyecek Bunu tıklayınca Koordinatlar butonu çıkacak
Koordinatlar tıklayınca kodlar çalışacaktır.

Fare ile İLK X koordinatı seçebilir veya
direk İLK X koordinatının bulunduğu hücreyi yazabilirsiniz.
ÖRNEK: $A$2 veya A2

Y koordinatı belirlediğiniz hücrenin yanında ki sütun olacak.
Z koordinatı Y koordinatı yanında ki sütun olacak.
Not: Y ve Z hücreleri boşsa eğer 0(sıfır) kabul edilecektir.

Bundan sonrasını Program kendisi otomatik yapacaktır.

Boş bir AutoCAD dosyası açtıktan sonra
4(Dört) adet Layer oluşturacaktır.
1.Layer: SiraNo (Layer:Açık, Yazdırma:Kapalı)
2.Layer: XKoordinat (Layer:Kapalı)
3.Layer: YKoordinat (Layer:Kapalı)
4.Layer: ZKoordinat (Layer:Kapalı)

1. SiraNo Layeri :
- Açık konumdadır ve yazdırma işlemi sirasında yazdırılmaz olarak ayarlanmıştır.
- İlk belirlediğiniz koordinattan itibaren kendisi sıra numarası verecektir.
- Text Height değeri 50 dir.

2. XKoordinat Layeri :
- Kapalı konumdadır.
- X Koordinatın değerini yazmaktadır
- Text Height değeri 100 dür.

3. YKoordinat Layeri :
- Kapalı konumdadır.
- Y Koordinatın değerini yazmaktadır
- Text Height değeri 100 dür.

4. ZKoordinat Layeri :
- Kapalı konumdadır.
- Z Koordinatın değerini yazmaktadır
- Text Height değeri 100 dür.

Tüm işlemler bittikten sonra
AutoCAd dosyasını Excel dosyanızla
aynı isimde ve aynı yerde(klasörde) kaydedip size bildirir.

********************
Excel Eklenti(XLA)Ekleme
Boş bir Excel açınız Araçlar - Eklentiler Tıklayınız
Gözat butonu Tıklayınız Bilgisayarınız da dosyayı bulup onaylayınız
Eklentiler penceresinide onayladıktan sonra kapatınız.
Artık tüm excel dosyalarınızda kodları çalıştırabilirsiniz.
********************

Not : Kullandığınız AutoCAD versiyonuna uygun dosyayı yükleyiniz.

Ekler:
Dosya: Koordinatlar2000.zip
Dosya içeriği: Koordinatlar2000.xla
AutoCAD2000 kullanıyorsanız bu dosyayı kullanınız.

Dosya: Koordinatlar2004.zip
Dosya içeriği: Koordinatlar2004.xla
AutoCAD2004 kullanıyorsanız bu dosyayı kullanınız.

Dosya: Koordinatlar2007.zip
Dosya içeriği: Koordinatlar2007.xla
AutoCAD2007 kullanıyorsanız bu dosyayı kullanınız.

Kolay gelsin.

BioCAD Tools

Merhaba,

BioCAD Tools (BioCAD araçlar menüsü - VBA - DVB)
AutoCAD Express Tools tarzındadır.
AutoCAD ana menüsünün en sonuna
BioCAD isminde yeni menü eklenir.
Kodlar AutoCAD VBA kullanılıp DVB dosyasına dönüştürülmüştür.
AutoCAD 2006 ve 2007 de test edilmiştir.

DVB dosyasının AutoCAD e nasıl YÜKLEneceğini önceden anlatmıştım.
Eğer BioCAD işinize yaramaz veya kullanmak istemezseniz
DVB dosyası nasıl İPTAL edilir bölümünde anlatmıştım.

BioCAD Tools içeriği :
1. MBS - Multiple Block Scale Change
Çoklu Block Raporu ve Scale değişimin de kullanılır.
VBA da UserForm Kullanılarak hazırlanmıştır.
- Aktif AutoCAD dosyasında bulunan Block sayını gösterir.
- Block listesini yazdırabilir.
- Blockların hepsini birden boyutlandırabilir.
- Blockların hepsini birden silebilirsiniz.

2. LDO - Layer DrawOrder
Layerlarla ilgili işlemler yapılır.
VBA da UserForm Kullanılarak hazırlanmıştır.
- Layerları istediğiniz şekilde sıralayıp
bu sıraya göre Layerleri DrawOrder yapabilme.
- Layer rengini direk degiştirebilme.
- Listeden seçilen layerin direk Current olabilmesi.

3. AKS - AKS Çizimi
Mimari AKS çizimi.
VBA da Module-Bas Kullanılarak hazırlanmıştır.
- Çiziminizde kullanılacak olan ölçek istenir.
- Yatay ve Dikey AKS aralıkları uzunlukları istenir.
- Aks a ait yeni Layer, TextStyle ve DimStyle ler hazır konumdadır.

Yakında: Kolon Çizimi, Ölçülendirme, Koordinat Girişi, STrim, NewSTrim eklenecektir.
Esasında şuan hazırlar ama Test aşamasındalar ;)

BioCAD Tools da güncelleme olduğun da bu başlık altında gerekli açıklamayı yapacağım

26.11.2007 Pazartesi
BioCAD Güncellendi

4. STrim

5. NewSTrim

6. KOLON Kolon Çizimi
Mimari projede kolon çizimi
VBA da UserForm kullanılarak hazırlanmıştır.
- Kolonun köşe noktasının aksa uzaklıkları istenir
- Girilen değerler yer değiştirilebilir
- Kolon en/boy ölçüsü değiştirilebilir
- Kolon kendi layer ında ve taranmış olarak aks kesişim noktasından tutulu olarak gelir

7. OL Ölçülendirme
Yatay ya da düşey çizgilere sürekli ölçü verilir
VBA da hazırlanmıştır
- Ölçülendirelecek çizgilerden biri istenir
- Seçilen çizginin yatay/düşey konumuna, layer’ına ve seçilen noktasına bağlı olarak aynı layer’daki diğer çizgiler otomatik seçili hale getirilir
- Seçme işlemine eklenecek ya da çıkartılacak çizgiler single yöntemi ile belirlenir
- Ölçü objesinin boyutlarını belirleyen ölçek istenir
- Peş peşe devam eden ölçülerin toplamının orta noktasından tutulu olarak getirilir ve ölçünün hangi noktadan geçeceği istenir.

8. KRD Koordinat
x-y koordinat değerleri verilerek aplikasyon krokisi çizimi
VBA da UserForm kullanılarak hazırlanmıştır.
- Her köşe noktasının x ve y değerleri virgülden sonra iki basamak şeklinde ayrı ayrı istenir
- Forma göre en az 3 noktanın x ve y değerleri istenir fazlası için “Satır Ekle” butonu ile yeni nokta için satır eklenir
- Girilen değerlerin oluşturduğu kapalı alan önizleme penceresinde görülebilir
- x ve y değerlerinin yerleri otomatik olarak değiştirilebilir
- Daha önceden .txt dosya formatında kaydedilmiş koordinat değerleri de otomatik olarak yüklenebilir
- Koordinat değerlerinizi .txt dosya formatında kaydedebilirsiniz
- Köşe noktaları çember ile gösterilerek çizim hazırlanır

BioCAD in gelişmesi sürecinde,
Önerileri, kodlalama da izlenilecek mantık ve test aşamasın da
bana yardımıncı olup, destek veren Mimar Murat ÇAĞIL'a
Teşekkür ederim.

28.02.2008 Perşembe
BioCAD Güncellendi
Güncelleme ile ilgili detaylar için Tıklayınız.

Ekler:
Dosya: BioCAD.zip
Dosya içeriği: BioCAD.dvb

Kolay gelsin.

BlockSelect2Excel

Merhaba,
BlockSelect2Excel : Çiziminizde belirlediğiniz bir bölgedeki blockların isim ve miktarlarını excel dosyasına kaydetmeye yarar.

BlockSelect2Excel.bas dosyasını yükledikten sonra Macromuz Excel ile etkileşimli çalışacağı için VBE de Excele Referans göstermeniz gerekli.
Bu ayarlamayı da yaptıktan sonra BlockSelect2Excel Macrosu çalıştırdığınız da

Sizden bir bölge seçmeniz veya objeler seçmeniz istenecek
seçiminiz bittikten sonra da (enter veya fare sağ tık seçim biter)
Seçiminiz de blok mevcud sa bunları listeleyip Excel dosyasına aktarır
kodların çalışması bittiğin de Excel dosyasının bilgisayarınızda ki yeri ve ismini söyleyecektir.

Not: Excel dosyası açıkken kodları çalıştırmayınız uyarı verir.

Sub BlockSelect2Excel()

' info(at)mentes.com.tr
' ibrahim Yorulmaz - Antalya - 2007
' o 532 625 55 66

' Not: Excele referans göstermeyi unutmayınız
' Tools - References...
' Microsoft Excel 11.0 Object Library
' Kullandığınız Excel sürümüne göre 11.0 degişebilir.

Dim BlockSS As AcadSelectionSet
Dim secili As Integer

ThisDrawing.Utility.Prompt "Lütfen saymak istediğiniz Bloklara ait bölge Seçiniz" & vbCrLf

On Error Resume Next
Set BlockSS = ThisDrawing.SelectionSets("BlockSS")
If Err Then Set BlockSS = ThisDrawing.SelectionSets.Add("BlockSS")
BlockSS.Clear
On Error GoTo 0

BlockSS.SelectOnScreen

Dim KacBlock As Integer
KacBlock = 0

' Secimde block varsa KacBlock degerini 1 yap
For secili = 0 To BlockSS.Count - 1
If BlockSS.Item(secili).ObjectName = "AcDbBlockReference" Then
KacBlock = 1
End If
Next secili

' eğer secimde block yoksa uyar
If KacBlock = 0 Then
MsgBox "Seçiminiz de Block bulunamadı !", vbInformation, "Block yok."
Exit Sub
End If

On Error GoTo UPSSHATA

Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object

' Excel i aç
Set Excel = New Excel.Application

' excel e kitap ekle
Set ExcelWorkbook = Excel.Workbooks.Add
' aktip excel kitap sayfasını belirle
Set ExcelSheet = Excel.ActiveSheet

' Excel uyarılarını yoksay
' dosya önceden varsa üzerine kaydedeyim mi sorusu iptali
Excel.DisplayAlerts = False

' Sayfa ismini Blocklar yap
ExcelSheet.Name = "Blocklar"

' excel kitabında bulunan sayfa sayısı kadar döngü
For Each Worksheet In Excel.ActiveWorkbook.Worksheets
' sayfa ismi Blocklar değilse
If Worksheet.Name <> "Blocklar" Then
' gereksiz bos sayfaları yok et
' excel alert vermesini yukarıda iptal etmiştik
Excel.Sheets(Worksheet.Name).Delete
End If
Next

Dim Dosyaismi
' dosyaismi= dwg dosyamızla aynı klasörde ve aynı isimde sadece dosya uzantısı xls(excel) oldu
Dosyaismi = Left(ThisDrawing.FullName, InStr(ThisDrawing.FullName, ".") - 1) & ".xls"

' excel kitabını kaydet
ExcelWorkbook.SaveAs Dosyaismi

' önce yazılan Sutunları yok et
ExcelSheet.Range("A1").EntireColumn.Delete
ExcelSheet.Range("A1").EntireColumn.Delete

Dim Satir As Integer
Satir = 1

' Blok isimlerinin hepsini A sutununa yaz
For secili = 0 To BlockSS.Count - 1
If BlockSS.Item(secili).ObjectName = "AcDbBlockReference" Then
ExcelSheet.Cells(Satir, 1).Value = BlockSS.Item(secili).Name
Satir = Satir + 1
End If
Next secili

' SelectionSets i yok et
BlockSS.Delete

' A sutununu alfabetik olarak sırala
Excel.Selection.Sort Key1:=ExcelSheet.Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

' A sutununda kaç tane dolu hucre oldugunu bul
Dim SatirAll
SatirAll = Excel.WorksheetFunction.CountA(ExcelSheet.Range("A1:A65500"))

' B sutununa excel EGERSAY formulunu uygulayıp değerini yaz
Dim Miktar As Integer
For Miktar = 1 To SatirAll
ExcelSheet.Cells(Miktar, 2).Value = Excel.WorksheetFunction.CountIf(ExcelSheet.Range("A:A"), ExcelSheet.Range("A" & Miktar))
Next Miktar

' A2 hücresinden itibaren A sutununda ki benzer satırları yok et
For Miktar = 1 To SatirAll
' A2 hucresinden başla ve Sonsuz döngüye girmemek için boş hücreye dikkat et
If Miktar > 1 And ExcelSheet.Cells(Miktar, 1).Value <> "" Then
If ExcelSheet.Cells(Miktar, 1).Value = ExcelSheet.Cells((Miktar - 1), 1).Value Then
ExcelSheet.Cells(Miktar, 1).EntireRow.Delete
' satır silindi miktarı geri al
Miktar = Miktar - 1
End If
End If
Next Miktar

' A ve B sutunlarını en uygun genişlik yap
ExcelSheet.Columns("A:A").EntireColumn.AutoFit
ExcelSheet.Columns("B:B").EntireColumn.AutoFit

' Excel i kaydet
ExcelWorkbook.Save

' excel uyarıları çalışır duruma getir
Excel.DisplayAlerts = True

' Exceli kapat
Excel.Application.Quit

Set ExcelSheet = Nothing
Set ExcelWorkbook = Nothing
Set Excel = Nothing

' işlem bitti dosya adresini söyle
MsgBox "Seçimizde ki mevcud blocklar listesi bilgisayarınız da" & vbCrLf & _
Dosyaismi & vbCrLf & _
"Excel dosyası olarak kaydedildi !", vbInformation, "Block Listesi Kaydedildi !"

Exit Sub

UPSSHATA:

Excel.Application.Quit
Set ExcelSheet = Nothing
Set ExcelWorkbook = Nothing
Set Excel = Nothing
MsgBox "HATA yaptık." & vbCr & Err.Description, vbCritical, "Hata oluştu !"
Err.Clear
Exit Sub

End Sub

Ekler:
Dosya: BlockSelect2Excel.zip
Dosya içeriği: BlockSelect2Excel.bas

Kolay gelsin