|
Penceresini açalım ve silindir adında yeni bir mvba dosyası oluşturalım.
|
İçine Kodlarımızı yazalım:
Sub Silindir()
Dim pointS As Point3d
Dim pointE As Point3d
Dim cap As Double
Dim oPipe As Element
Dim levname As String
cap = 10
Set oXL = GetObject(, "Excel.Application")
Set oSheet = oXL.activeWorkbook.activesheet
k = 2
Do While oSheet.cells(k, 1) <> ""
pointS.X = 0
pointS.Y = -oSheet.cells(k, 2)
pointS.Z = 0
pointE.X = 0
pointE.Y = -oSheet.cells(k, 3)
pointE.Z = 0
levname = oSheet.cells(k, 4)
Set oPipe = SilindirCiz(pointS, pointE, cap, msdDrawingModeNormal)
oPipe.Level = myLevel(levname)
ActiveModelReference.AddElement oPipe
k = k + 1
Loop
End Sub
Private Function SilindirCiz(ByRef startPoint As Point3d, ByRef endPoint As Point3d, ByVal radius As Double, ByVal drawMode As MsdDrawingMode) As Element
Set SilindirCiz = Nothing
Dim oCone As ConeElement
Set oCone = CreateConeElement1(Nothing, radius, startPoint, radius, endPoint, Matrix3dIdentity)
oCone.Redraw drawMode
Set SilindirCiz = oCone
End Function
Private Function myLevel(levname As String) As Level
Set myLevel = ActiveDesignFile.Levels.Find(levname)
If myLevel Is Nothing Then
CadInputQueue.SendKeyin "level create " & Chr(34) & levname & Chr(34)
Set myLevel = ActiveDesignFile.Levels.Find(levname)
End If
End Function
Bu örnek dahada geliştirilebilir.
Örneğin 5 sütuna renk bilgisi eklenipoPipe.Color = oSheet.cells(k, 5) dediğimizde rengide excelden alınabilir. | |
Programı çalıştırmak için Key-in komut satırına
vba run Silindir dememiz yeterli. |
Çalışması için çalışma sayfası 3D, Excel dosyasının açık olması ve nokta bilgilerinin sayfası aktif olmalıdır.
silindir.mvba
silindir.mvba
Hiç yorum yok:
Yorum Gönder