Kalsefar Posted October 21, 2020 Posted October 21, 2020 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 EXCEL_FILE.xls 1 Quote
Dadgad Posted October 22, 2020 Posted October 22, 2020 That would be the Default Origin in modelspace, I should think. Never do that, so no experience with it specifically. Quote
Kalsefar Posted October 22, 2020 Author Posted October 22, 2020 @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 1 Quote
BIGAL Posted October 22, 2020 Posted October 22, 2020 My VBA is limited but looks like Range("START_1") is starting at row 2 and not row3. Quote
Kalsefar Posted October 23, 2020 Author Posted October 23, 2020 @BIGAL No, I tried still have the same problem 1 Quote
Elias Posted October 23, 2020 Posted October 23, 2020 Try to contact Mr. @sanju2323he has a good knowledge of VBA. Quote
PeterPan9720 Posted October 26, 2020 Posted October 26, 2020 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 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. Quote
Kalsefar Posted October 27, 2020 Author Posted October 27, 2020 @PeterPan9720 I didn't find your answer on the Autodesk forum can you please attach the link 1 Quote
PeterPan9720 Posted October 27, 2020 Posted October 27, 2020 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 Quote
sanju2323 Posted October 31, 2020 Posted October 31, 2020 Please find the attachment as per your request EXCEL_FILE.xls 1 Quote
Kalsefar Posted November 1, 2020 Author Posted November 1, 2020 23 hours ago, sanju2323 said: Please find the attachment as per your request EXCEL_FILE.xls 2.18 MB · 2 downloads You are great Bro. 1 Quote
Recommended Posts
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.