Jump to content

DATA EXPORT


Kalsefar

Recommended Posts

I face the same problem every time I export the data from Excel to AutoCAD which is a point exported on location X:0.00 , Y:0.00 , Z:0.00 I don't know why it exports a point in that location ?!

Can someone please help me?

 

Look to the attached picture to be more clear

Thanks 

2020-10-21_215451.jpg

EXCEL_FILE.xls

  • Thanks 1
Link to comment
Share on other sites

@SLW210

 

Sir,

I attached Excel file have the code 

 

This is the code :

_______________________________________________________________________________________________________

Private Sub CommandButton1_Click()

    TextHeight = TextBox30.Text
    If IsNumeric(TextHeight) = False Or TextHeight = 0 Then TextHeight = 0.25
    DeltaX = TextBox31.Text
    DeltaY = TextBox32.Text
    

    Dim qst
    Dim acadObj As Object
    Dim ExcelObj As Object
        On Error Resume Next
    Set acadObj = GetObject(, "AutoCAD.Application")
    If acadObj Is Nothing Then
    qst = MsgBox("AutoCAD Is Not Open. DoYou Want To Open AutoCAD With A New Drawing?", vbYesNo)
    If qst <> vbYes Then Exit Sub
    Set acadObj = CreateObject("AutoCAD.Application")
     Cells(2, 9) = ""
    Command6.Visible = True
    Command7.Visible = True
    End If
    If acadObj Is Nothing Then
    MsgBox "You Have No AutoCad Software In Your Computer." & " Sorry, You Can't Use This Programe Without AutoCad." & vbNewLine & "If You Are Sure You Have AutoCAD In Side Your Computer, Then Please Check VBA Enabeled In AutoCAD.", vbCritical, "CSV TO AUTOCAD"
    Exit Sub
    End If

    '**************************************************************8
If CheckBox5.Value = True Then
        Dim strLayerName1, strLayerName2, strLayerName3, strLayerName4 As String
    Dim objLayer1, objLayer2, objLayer3, objLayer4 As Object

    strLayerName1 = TextBox33.Text
    If "" = strLayerName1 Then Exit Sub       ' exit if no name entered

    On Error Resume Next                 ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer1 = acadObj.ActiveDocument.Layers(strLayerName1)

    If objLayer1 Is Nothing Then
        Set objLayer1 = acadObj.ActiveDocument.Layers.Add(strLayerName1)
        If objLayer1 Is Nothing Then ' check if obj has been set
            lyt = "'" & strLayerName1 & "'" & vbNewLine
        Else
            'MsgBox "Added Layer '" & objLayer.Name & "'"
        End If
    Else
        'MsgBox "Layer already existed"
    End If
'************************************************************
     strLayerName2 = TextBox34.Text
    'If "" = strLayerName2 Then Exit Sub       ' exit if no name entered

    On Error Resume Next                 ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer2 = acadObj.ActiveDocument.Layers(strLayerName2)

    If objLayer2 Is Nothing Then
        Set objLayer2 = acadObj.ActiveDocument.Layers.Add(strLayerName2)
        If objLayer2 Is Nothing Then ' check if obj has been set
            lyt = lyt & "'" & strLayerName2 & "'" & vbNewLine
        Else
            'MsgBox "Added Layer Layer '" & objLayer.Name & "'"
        End If
    Else
        'MsgBox "Layer already existed"
    End If
    End If
'******************************************************************
    Dim basePnt(0 To 2) As Double
    Dim insertPnt(0 To 2) As Double
            Dim strLayerName5 As String
    Dim objLayer5 As Object

    Set ExcelObj = GetObject(, "Excel.Application")
    Set acadObj = GetObject(, "AutoCAD.Application")
    ExcelObj.WindowState = xlMinimized
    acadObj.WindowState = vbMaximizedFocus
    
    Do
        i = i + 1
        If Range("START_1").Offset(i, 0).Value <> "x" And Range("START_1").Offset(i, 0).Value <> "X" Then
            '************************************************
            If CheckBox7.Value = True Then
objLayer5 = Empty
    strLayerName5 = Range("START_1").Offset(i, 4).Text
    If "" = strLayerName5 Then GoTo Dick      ' exit if no name entered

    On Error Resume Next                 ' handle exceptions inline
    'check to see if layer already exists
    Set objLayer5 = acadObj.ActiveDocument.Layers(strLayerName5)

    'If objLayer5 Is Nothing Then
        Set objLayer5 = acadObj.ActiveDocument.Layers.Add(strLayerName5)
        If objLayer5 Is Nothing Then ' check if obj has been set
            lyt = "'" & strLayerName5 & "'" & vbNewLine
        Else
            'MsgBox "Added Layer '" & objLayer.Name & "'"
        End If
    'Else
        'MsgBox "Layer already existed"
    'End If
    End If

        '*********************************************************
Dick:
            basePnt(0) = Range("START_1").Offset(i, 0).Value
            basePnt(1) = Range("START_1").Offset(i, 1).Value
            basePnt(2) = Range("START_1").Offset(i, 2).Value
        If TextBox33.Enabled = True Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName1)
                    If CheckBox7.Value = True Then
        If "" <> strLayerName5 Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName5)
          Else
          If TextBox34.Enabled = False Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers("0")
          End If
pointObj = Nothing
            Set pointObj = acadObj.ActiveDocument.ModelSpace.AddPoint(basePnt)
            If pointObj Is Nothing Then MsgBox ("AutoCAD Not Responding"): Exit Sub
            insertPnt(0) = basePnt(0) + DeltaX
            insertPnt(1) = basePnt(1) + DeltaY
            insertPnt(2) = 0
            
            If pointObj Is Nothing Then acadObj.WindowState = vbMinimizedFocus: ExcelObj.WindowState = xlMaximized: MsgBox "Sorry, AutoCad Application Is Not Responding.", vbCritical
            'Set pointText = acadObj.ActiveDocument.modelspace.AddText(Range("START_1").Offset(i, -1).Value, insertPnt, TextHeight)
        If TextBox34.Enabled = True Then acadObj.ActiveDocument.ActiveLayer = acadObj.ActiveDocument.Layers(strLayerName2)
          
            If CheckBox30.Value = True Then TEXT_POINT = Range("START_1").Offset(i, -1).Value & Chr(10)
            If CheckBox31.Value = True Then TEXT_POINT = TEXT_POINT & "X= " & basePnt(0) & Chr(10)
            If CheckBox32.Value = True Then TEXT_POINT = TEXT_POINT & "Y= " & basePnt(1) & Chr(10)
            If CheckBox33.Value = True Then TEXT_POINT = TEXT_POINT & "Z= " & basePnt(2)
            Set pointText = acadObj.ActiveDocument.ModelSpace.AddMText(insertPnt, 0, TEXT_POINT)
            pointText.Height = TextHeight
            TEXT_POINT = ""
            
            pointObj.Color = Range("START_1").Offset(i, 3).Value
        End If
    Loop Until Range("START_1").Offset(i, 0).Value = ""
    
    'ExcelObj.WindowState = xlMaximized
    'acadObj.WindowState = vbMinimizedFocus
    
    Dim jj
    jj = (i * 3) - 1
    Dim dblVertices() As Double
ReDim dblVertices(jj)
    If CheckBox34.Value = True Then
    'acadObj.Activedocument.ActiveLayer = acadObj.Activedocument.Layers(strLayerName4)
   ' Dim COUNT, CO As Integer
    co = 0
    For Count = 1 To i
    dblVertices(co) = Range("START_1").Offset(Count, 0).Value
    co = co + 1
    dblVertices(co) = Range("START_1").Offset(Count, 1).Value
    co = co + 1
    dblVertices(co) = Range("START_1").Offset(Count, 2).Value
    co = co + 1
    Next Count
    Set objEnt = acadObj.ActiveDocument.ModelSpace.Add3DPoly(dblVertices)

End If

End Sub

  • Thanks 1
Link to comment
Share on other sites

On 10/21/2020 at 9:10 PM, Kalsefar said:

I face the same problem every time I export the data from Excel to AutoCAD which is a point exported on location X:0.00 , Y:0.00 , Z:0.00 I don't know why it exports a point in that location ?!

Can someone please help me?

 

Look to the attached picture to be more clear

Thanks 

2020-10-21_215451.jpg

EXCEL_FILE.xls 2.18 MB · 8 downloads

See my answer on Autodesk forum, in any case did you try to trace a line from coords 0,0 settled by hand not by pointer ? just to understand if really your procedure point @0,0 coord.

Link to comment
Share on other sites

2 minutes ago, Kalsefar said:

@PeterPan9720 I didn't find your answer on the Autodesk forum can you please attach the link 

Probably  I made some confusion, in any case did you try to trace a line from coords 0,0 settled by hand not by pointer ? just to understand if really your procedure point @0,0 coord.

 

3 minutes ago, Kalsefar said:

@PeterPan9720 I didn't find your answer on the Autodesk forum can you please attach the link 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...