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.