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
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
El código me funciona perfecto. Permite dibujar polilíneas en 3d.
El código me funciona perfecto. Permite dibujar polilíneas en 3d.
Can't find what you're looking for? Ask the community or share your knowledge.