BioCAD Tools V3

Merhaba

BioCAD bu yeni versiyonunda bir önce ki mesajımda açıkladığım
Block Yerleşimi deki kodları BioCAD e dahil ettim.

Kısaca belirlediğiniz bir alan içerisine,
yine kendimizin belirlediği bir block u
eşit oranlar da bu alana dizmeye yarayan ARM(armatur.bas)
AutoCAD VBA kodlarını BioCAD e modül olarak ekledim.

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

Kolay gelsin.

Block Yerleşimi

Merhaba,
Bir Block u belirlediğimiz bir alan içerisin de eşit mesafeler de yerleştirmemize yarar.
Örnek : Bir Oda içerisine Armatür blocklarımızı düzgün bir şekilde yerleştirmek istediğimiz de oldukca kullanışlı olacaktır.

Ben bunu ilk olarak lisp le çözümünü gördüm ve bunu VBA ya dönüştürmek istedim.
Lispi www.autocadokulu.com un Forum sayfasın da @wolf nickini kullanan bir arkadaş yayınlamıştı.
Dilerseniz Lisp i deneyebilirsiniz. Lisp yükle(arm.fas)

İlk olarak Blockları yerleştirecegimiz alanın Sol Alt noktası,
ardın dan Sağ Üstnoktanın işaretlenmesi istenir,
Bu sayede alanın genişliği ve yüksekliği tespit edilir.

Yatay da ve Dikey de kaç edet Block yerleştirilmek istendiği sorulur.
boş geçilir ise varsıyan değer olarak 1(bir) belirledim.

Hemen ardından bu alanın içine yerleştirmek istediğimiz Block un ismi istenir.
eğer block ismi verilmez veya block bulunamaz sa varsayılan olarak uygun yerlere sadece Nokta(Point) yerleştirmesini sağladım.

Not: Yakın zaman da BioCAD e dahil edeceğim oldukca kullanışlı ;)

Sub armaturdiz()
ThisDrawing.SendCommand Chr(3) & Chr(3)

On Error Resume Next
Dim returnPnt1 As Variant
Dim returnPnt2 As Variant
Dim DikMiktar As Double
Dim YatayMiktar As Double
Dim BlockName As String

returnPnt1 = ThisDrawing.Utility.GetPoint(, "Sol alt noktasini isaretleyin: ")

If Err Then
ThisDrawing.Utility.Prompt "Program sonlandırıldı."
ThisDrawing.SendCommand Chr(3) & Chr(3)
Err.Clear
Exit Sub
End If

returnPnt2 = ThisDrawing.Utility.GetPoint(, "Sag ust noktasini isaretleyin: ")

If Err Then
ThisDrawing.Utility.Prompt "Program sonlandırıldı."
ThisDrawing.SendCommand Chr(3) & Chr(3)
Err.Clear
Exit Sub
End If

DikMiktar = ThisDrawing.Utility.GetReal("Yatay Block sayısı<1> |||: ")
If Err Then
If StrComp(Err.Description, "User input is a keyword", 1) = 0 Then
Err.Clear
DikMiktar = 1
Else
' esc tıklamıştır işlemi sonlandır
ThisDrawing.Utility.Prompt "Program sonlandırıldı."
ThisDrawing.SendCommand Chr(3) & Chr(3)
Err.Clear
Exit Sub
End If
End If

YatayMiktar = ThisDrawing.Utility.GetReal("Dikey Block sayısı<1> ---: ")
If Err Then
If StrComp(Err.Description, "User input is a keyword", 1) = 0 Then
Err.Clear
YatayMiktar = 1
Else
' esc tıklamıştır işlemi sonlandır
ThisDrawing.Utility.Prompt "Program sonlandırıldı."
ThisDrawing.SendCommand Chr(3) & Chr(3)
Err.Clear
Exit Sub
End If
End If

BlockName = ThisDrawing.Utility.GetString(False, "Yerleştirilecek Block un adını giriniz(Space, Enter veya Block yoksa<Nokta>): ")
If Err Then
ThisDrawing.Utility.Prompt "Program sonlandırıldı."
ThisDrawing.SendCommand Chr(3) & Chr(3)
Err.Clear
Exit Sub
End If

On Error GoTo 0

Dim pointObj As AcadPoint
Dim BlockNameVar As Boolean
Dim blockRefObj As AcadBlock
Dim blockRefObj01 As AcadBlockReference
Dim insertionPnt(0 To 2) As Double
Dim blkColl As AcadBlocks
Set blkColl = ThisDrawing.Blocks

For Each blockRefObj In blkColl
If blockRefObj.Name = BlockName Then
BlockNameVar = True
End If
Next

' cizim içinde bir block değilse dwg uzantısı ekle
If BlockNameVar = False Then
BlockName = BlockName & ".dwg"
End If

For i = 1 To (YatayMiktar * 2) Step 2
For k = 1 To (DikMiktar * 2) Step 2

insertionPnt(0) = (returnPnt1(0) + ((returnPnt2(0) - returnPnt1(0)) / (DikMiktar * 2) * k))
insertionPnt(1) = (returnPnt1(1) + ((returnPnt2(1) - returnPnt1(1)) / (YatayMiktar * 2) * i))
insertionPnt(2) = 0

If BlockName <> "" Then

On Error Resume Next
Set blockRefObj01 = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlockName, 1#, 1#, 1#, 0)
' Block bilgisayarda yoksa yerine nokta koy
If Err Then
Set pointObj = ThisDrawing.ModelSpace.AddPoint(insertionPnt)
Err.Clear
End If

On Error GoTo 0

Else
' Sadece işaretlemek isterse Nokta koy
Set pointObj = ThisDrawing.ModelSpace.AddPoint(insertionPnt)
End If

Next k
Next i

End Sub 

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

Kolay gelsin

BioCAD Tools V2

Merhaba

BioCAD bu yeni versiyonunda Genelin de bir değişiklik oldu ama
kodlar şifreli olduğundan bunu gözlemliyemiyorsunuz
eğer gerçekten ilginiz varsa özel mesaj çekip kodları görebilirsiniz
ilgilendiğiniz bölümün Kodlarını görebilirsiniz.

Bu yeni versiyonda en büyük degişiklik Block larla ilgili olan
MBS - Multiple Block Scale Change
kodlarında oldu MBS ile yapılabilecekler
*- Belirli bir bölge seçip o bölgede ki blokları listeleyebilir.
- Aktif AutoCAD dosyasın da kullanılan tüm Blockları Listeleyebilir.
- Listelenen Blocklardan şeçtiklerinizin hepsini birden Boyutlandırabilir(Scale).
- Listelenen Blocklardan şeçtiklerinizin hepsini birden Silebilirsiniz(Delete).
*- Listelenen Blocklardan şeçtiklerinizin hepsini birden Çevirebilir(Rotate).
*- Listelenen Blockları TEXT (*.txt) dosyası olarak Kaydedebilirsiniz.
*- Listelenen Blockları EXCEL (*.xls) dosyası olarak Kaydedebilirsiniz.

Not:
* Dynamic Bloklarınız da gösterilebilecektir artık
özellikle Visibility özelliği olanlar ayrı ayrı ;)
BioCAD le ilgili ana açıklamalayı BioCAD Tools sayfasında bulabilirsiniz.

* İşareti Yeni eklenen özellikleri temsil eder.

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

Kolay gelsin.

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.