Jump to content
Kalsefar

DATA EXPORT

Recommended Posts

Kalsefar

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

Share this post


Link to post
Share on other sites
SLW210

What is your code?

Share this post


Link to post
Share on other sites
Dadgad

That would be the Default Origin in modelspace, I should think.    :|

Never do that, so no experience with it specifically.

Share this post


Link to post
Share on other sites
Kalsefar

@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

Share this post


Link to post
Share on other sites
BIGAL

My VBA is limited but looks like Range("START_1") is starting at row 2 and not row3.

Share this post


Link to post
Share on other sites
Kalsefar

@BIGAL

No, I tried still have the same problem

  • Like 1

Share this post


Link to post
Share on other sites
Elias

Try to contact Mr. @sanju2323he has a good knowledge of VBA.

Share this post


Link to post
Share on other sites
PeterPan9720
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.

Share this post


Link to post
Share on other sites
Kalsefar

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

  • Thanks 1

Share this post


Link to post
Share on other sites
PeterPan9720
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 

 

Share this post


Link to post
Share on other sites
sanju2323

Please find the attachment as per your request

EXCEL_FILE.xls

  • Thanks 1

Share this post


Link to post
Share on other sites
sanju2323

your welcome..

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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...