My code

My code

Anonymous
Not applicable
456 Views
3 Replies
Message 1 of 4

My code

Anonymous
Not applicable
Frank,

Here is my sub which does the work. The myApp part was a try to avoid using
ThisDrawing...

Michel.



Private Sub cmdScan_Click()
Dim i As Long
Dim FileNumber As Integer
Dim strname As String
Dim myApp As AutoCAD.AcadApplication

On Error GoTo err_bloc

If List1.ListCount = 0 Then Exit Sub
Me.MousePointer = fmMousePointerHourGlass
Me.hide
FileNumber = FreeFile ' Get unused file number.
Open thePath & "SigaScan_" & Date & ".txt" For Output As #FileNumber
Print #FileNumber, "Répertoire (serveur): " & thePath & vbCrLf

Set myApp = ThisDrawing.Application
For i = 0 To List1.ListCount - 1
myApp.Documents.Open thePath & List1.List(i)
myApp.ZoomExtents
Print #FileNumber, myApp.Caption
myApp.ActiveDocument.Close False
Next i
Close #FileNumber ' Close file
Me.Show

defaut_bloc:

Me.MousePointer = fmMousePointerDefault
Set myApp = Nothing

Exit Sub

err_bloc:
Select Case Err.Number
Case 76
MsgBox "Oops!"
Resume defaut_bloc
Case Else
MsgBox "Erreur: " & Err.Number
Resume defaut_bloc
End Select

End Sub
0 Likes
457 Views
3 Replies
Replies (3)
Message 2 of 4

Anonymous
Not applicable
Michel R. had this to say
:
> Here is my sub which does the work

I'm confused. Your code opens a drawing, performs a zoom extents, writes
the application caption to a text file then closes the file while
discarding the changes.

That seems like an awful lot of work for nothing more than a log. What
am I not understanding?

--
There are 10 kinds of people:
Those who understand binary and those who don't
http://www.acadx.com
http://vbxtender.sourceforge.net
0 Likes
Message 3 of 4

Anonymous
Not applicable
It's all it does for the moment but a lot of validations and modifications
to each drawing will go in between in a few days! I just plugged in a zoom
extents for now, just to do something!

Michel.

"Frank Oquendo" a écrit dans le message news:
1A09A880F2EB2EFCB5928232409CF8DE@in.WebX.maYIadrTaRb...
> Michel R. had this to say
> :
> > Here is my sub which does the work
>
> I'm confused. Your code opens a drawing, performs a zoom extents, writes
> the application caption to a text file then closes the file while
> discarding the changes.
>
> That seems like an awful lot of work for nothing more than a log. What
> am I not understanding?
>
> --
> There are 10 kinds of people:
> Those who understand binary and those who don't
> http://www.acadx.com
> http://vbxtender.sourceforge.net
>
>
>
0 Likes
Message 4 of 4

Anonymous
Not applicable
My problem is solved, I'm not sure why but it is, that's the most important
for me right now!

I was running my app under an unregistered AutoCAD 2002 (14 days grace). I
finally got my full registered version and the problem is gone. Can't tell
why but I don't really care for the moment, as long it doesn't reappear!

Michel.

"Michel R." a écrit dans le message news:
53764AFE69A25978865378DE91E31ED2@in.WebX.maYIadrTaRb...
> Frank,
>
> Here is my sub which does the work. The myApp part was a try to avoid
using
> ThisDrawing...
>
> Michel.
>
>
>
> Private Sub cmdScan_Click()
> Dim i As Long
> Dim FileNumber As Integer
> Dim strname As String
> Dim myApp As AutoCAD.AcadApplication
>
> On Error GoTo err_bloc
>
> If List1.ListCount = 0 Then Exit Sub
> Me.MousePointer = fmMousePointerHourGlass
> Me.hide
> FileNumber = FreeFile ' Get unused file number.
> Open thePath & "SigaScan_" & Date & ".txt" For Output As #FileNumber
> Print #FileNumber, "Répertoire (serveur): " & thePath & vbCrLf
>
> Set myApp = ThisDrawing.Application
> For i = 0 To List1.ListCount - 1
> myApp.Documents.Open thePath & List1.List(i)
> myApp.ZoomExtents
> Print #FileNumber, myApp.Caption
> myApp.ActiveDocument.Close False
> Next i
> Close #FileNumber ' Close file
> Me.Show
>
> defaut_bloc:
>
> Me.MousePointer = fmMousePointerDefault
> Set myApp = Nothing
>
> Exit Sub
>
> err_bloc:
> Select Case Err.Number
> Case 76
> MsgBox "Oops!"
> Resume defaut_bloc
> Case Else
> MsgBox "Erreur: " & Err.Number
> Resume defaut_bloc
> End Select
>
> End Sub
>
>
0 Likes