Message 1 of 2
Drawing 3d poly via excel vba code
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Greetings and help needed
I have vba excel code for drawing 3dpoly, but I can't set the condition from which point to draw a line for me. The condition is in column "F" as "SL" (startline) and "EL" as endline. Which means he wants me to draw a line from SL to EL. Thank you in advance
Sub otac()
Dim acadApp As Object
Dim acadDoc As Object
Dim LastRow As Long
Dim i As Long
Dim Point() As Double
Dim j As Long
Dim linija As Acad3DPolyline
Dim k As Long
Dim kod As Range
Dim kodv As Variant
Dim kode As Long
Dim kods As Long
Dim x As Long
Dim cell As Range
With Sheets("Coordinates")
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
If LastRow < 2 Then
MsgBox "Nema koordinata!", vbCritical, "Upozorenje"
Exit Sub
End If
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If acadApp Is Nothing Then
Set acadApp = CreateObject("AutoCAD.Application")
acadApp.Visible = True
End If
On Error Resume Next
Set acadDoc = acadApp.ActiveDocument
If acadDoc Is Nothing Then
Set acadDoc = acadApp.Documents.Add
End If
If acadDoc.ActiveSpace = 0 Then
acadDoc.ActiveSpace = 1
End If
ReDim Point(3 * (LastRow - 1) - 1)
'Pass the coordinates to array.
Set kod = Range("F").Value
k = 0
For i = 2 To LastRow
For j = 2 To 4
Point(k) = Sheets("Coordinates").Cells(i, j)
k = k + 1
Next j
Next i
Set linija = acadDoc.ModelSpace.Add3DPoly(Point)
linija.Closed = False
linija.Update
acadApp.ZoomExtents
Set acadDoc = Nothing
Set acadApp = Nothing
MsgBox "KARTIRANO", vbInformation, "INFO"
End Sub