VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Drawing 3d poly via excel vba code

1 REPLY 1
Reply
Message 1 of 2
savic767
493 Views, 1 Reply

Drawing 3d poly via excel vba code

savic767
Observer
Observer

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
0 Likes

Drawing 3d poly via excel vba code

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
1 REPLY 1
Message 2 of 2
Ray-Sync
in reply to: savic767

Ray-Sync
Advocate
Advocate

El código me funciona perfecto. Permite dibujar polilíneas en 3d.

jefer_ing_0-1665330998872.pngjefer_ing_1-1665331072253.pngjefer_ing_2-1665331095502.png

 

jefferson
0 Likes

El código me funciona perfecto. Permite dibujar polilíneas en 3d.

jefer_ing_0-1665330998872.pngjefer_ing_1-1665331072253.pngjefer_ing_2-1665331095502.png

 

jefferson

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report