mdiaconu Posted December 18, 2009 Posted December 18, 2009 Hi all! I have a road project drawings and I want to transfer some data to Excel in order to verify their correctness. I have wrote the following code : Option Explicit Sub transfer() Dim myobj As AcadObject, pct As Variant, txt As String, txt1 As String Dim celApp As Excel.Application, wobj As Workbook, sobj As Worksheet Dim i As Long, RETRAY As Label Set celApp = CreateObject("Excel.Application"): celApp.Visible = True Set wobj = celApp.Workbooks.Add: Set sobj = celApp.Worksheets(1):_ sobj.Range("A1").Activate On Error Resume Next With ThisDrawing RETRAY: ThisDrawing.Utility.GetEntity myobj, pct If myobj.ObjectName = "AcDbSpline" Then Exit Sub If Err 0 Or myobj.ObjectName "AcDbText" Then Err.Clear: GoTo RETRAY myobj.Visible = False: txt = myobj.TextString: txt1 = "" For i = 1 To Len(txt) If Asc(Mid(txt, i, 1)) 32 And Asc(Mid(txt, i, 1)) 43 Then_ txt1 = txt1 + (Mid(txt, i, 1)) Next If txt1 "" And Val(txt1) = 0 Then GoTo RETRAY Else _ ActiveCell.Offset(1, 0).Activate: ActiveCell.Value = Val(txt1) GoTo RETRAY End With End Sub The above code works but, because I don't know a smartly way to stop it, I must add every drawing, for example, a spline obj and to select it when I want to exit. Could somebody help me in order to exit the above routine by pressing a key ? Thank you for reply. Best regards, Marius 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.