PDA

View Full Version : AutoCAD VBA help with files in dir



RMS
08-31-2007, 10:52 AM
Hello Everyone!

I have some code that I am trying to fix, what this should do when ran is go through all the dxf files in a folder, make a layer, save and go to the next, oh and I am trying to delete paper space. I think its the File Search command its in MS Office but I am running this through AutoCAD2005 any help would be greatly appreciated. -Thanks



Option Explicit
Public Sub scopyfiles()
On Error GoTo errorhandler
Dim ofs As Object
Dim osearch As Object
Dim sdir, shold As String
Dim iouter, iinner As Integer
Dim icheck As Integer
Dim smessage As String
Dim layerObj As AcadLayer
Dim color As AcadAcCmColor
Dim st As String
Set layerObj = ThisDrawing.Layers.Add("ABC")
Set ofs = CreateObject("Scripting.FileSystemObject")
Set osearch = Application.FileSearch
For iouter = 1 To 900
osearch.lookin = "D:\Rob_Souza\Poly\VBATEST" ' location
osearch.FileName = "*.dxf"

If osearch.Execute > 0 Then
For iinner = 1 To osearch.foundfiles.Count
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")
Call color.SetRGB(80, 100, 244)
layerObj.TrueColor = color
ZoomAll
End If
ofs.savefile
Next
End If
Next
MsgBox ("files changed")
Set ofs = Nothing
Set osearch = Nothing
DoCmd.Quit
Exit Sub
errorhandler:
Set ofs = Nothing
Set osearch = Nothing
MsgBox ("error encountered")
End Sub

fixo
09-02-2007, 10:00 AM
Hi, Rob
SaveAs DXF method is difficult a bit
Here is semi-solution
All the changed dxf files should be saved in
the separate folder
You need to run this code from the drawing located
in other folder than your dxf files folder
Give this a shot



Option Explicit
Sub ProcDXFs()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' Requires reference to Microsoft Scripting Runtime
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Dim fs
Dim objFolder As Object
Dim objInFolder As Object
Dim newFolder As Object
Dim objFile As Object
Dim strOldFolder As String
Dim lngCount As Long, lngFolders As Long
Dim strFileType As String
Dim strFolders() As String
Dim n As Long
n = 0
strOldFolder = "D:\Rob_Souza\Poly\VBATEST"
On Error GoTo ErrHandler
Set fs = CreateObject("Scripting.FileSystemObject")
Set objFolder = fs.GetFolder(strOldFolder)
Set newFolder = fs.CreateFolder("D:\Rob_Souza\Poly\VBATEST\Edited")'<-- change new folder name to suit
ReDim strFiles(objFolder.Files.Count - 1) As String
For Each objFile In objFolder.Files
If UCase(objFile.Path) Like "*.DXF" Then
strFiles(n) = objFile.Path
n = n + 1
End If
Next

ThisDrawing.SetVariable "FILEDIA", 0
ThisDrawing.SetVariable "SDI", 0
Dim curName As String
curName = ThisDrawing.FullName
Dim olayout As AcadLayout
Dim layerObj As AcadLayer
Dim color As AcadAcCmColor
Set color = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")

Dim pt(2) As Double
pt(0) = 0: pt(1) = 0: pt(2) = 0

For n = 0 To UBound(strFiles)
Dim aDoc As AcadDocument
Set aDoc = Documents.Open(strFiles(n), False)

On Error Resume Next
For Each olayout In ThisDrawing.Layouts
If olayout.Block.Name = "*PAPER_SPACE" Then
olayout.Delete
End If
If Err Then
Err.Clear
End If
Next
On Error GoTo 0

Set layerObj = aDoc.Layers.Add("NewLayer")
Call color.SetRGB(80, 100, 244)
layerObj.TrueColor = color
' do your other stuff here e.g. add text :
aDoc.ModelSpace.AddText "Test string must follows here", pt, 100#
ZoomAll

Dim sfileName As String
Dim sset As AcadSelectionSet
Set sset = aDoc.SelectionSets.Add("$ExportDXF$")
sset.Select acSelectionSetAll
sfileName = Replace(aDoc.Name, ".dwg", "")
aDoc.Export newFolder.Path & "\" & sfileName, "DXF", sset
Next

For Each aDoc In Documents
If aDoc.FullName <> curName Then
aDoc.Close False
End If
Next

Exit_Here:

ThisDrawing.SetVariable "FILEDIA", 1
Set color = Nothing
Exit Sub

ErrHandler:
If Err.Number <> 0 Then
MsgBox Err.Number & " : " & Err.Description
Resume Exit_Here
End If

End Sub


~'J'~

RMS
09-04-2007, 09:32 AM
Hi Fatty!

Great Job, and thanks for helping me out with this. Its working good, though for some reason the paper space or layout tab does not delete and actually even manually I could not delete it. I am currently trying to get this code to also make the Model Space tab active before it saves in the new folder.

Rob

lucas
09-04-2007, 09:43 AM
I don't think you can delete all of the model and paper space tabs. I think you must have one of each. Just as in Excel you can't delete all of the sheets...you must leave one.

RMS
09-04-2007, 09:56 AM
I don't think you can delete all of the model and paper space tabs. I think you must have one of each. Just as in Excel you can't delete all of the sheets...you must leave one.

Interesting, in version 2000 I thought I could set it up with only a model space tab by not enabeling paper space durring MVsetup. I am using 2005 now and I think you are right. So what I will do is just activate the model tabe with this:

ThisDrawing.ActiveSpace = acModelSpace

Thanks!

fixo
09-04-2007, 10:19 AM
Hi Rob
Sorry for the late
Glad you solved this problem by yourself
Happy coding :)

~'J'~

fixo
09-04-2007, 10:21 AM
I don't think you can delete all of the model and paper space tabs. I think you must have one of each. Just as in Excel you can't delete all of the sheets...you must leave one.

Thanks, Lucas
I agreed with you
Regards,

~'J'~

lucas
09-04-2007, 10:29 AM
Hi fatty,
yeah I use this to delete all paperspace layouts except one...
Option Explicit
Sub DeleteLayouts()
Dim adLayout As AcadLayout
On Error Resume Next
If ThisDrawing.ActiveSpace = acPaperSpace Then _
ThisDrawing.ActiveSpace = acModelSpace
For Each adLayout In ThisDrawing.Layouts
adLayout.Delete
Next adLayout
End Sub

fixo
09-04-2007, 11:12 AM
Hi lucas

I could not to delete the last layout
the same as you are
Just manually :)

Cheers :)

~'J'~

RMS
09-04-2007, 11:37 AM
Hi Rob
Sorry for the late
Glad you solved this problem by yourself
Happy coding :)

~'J'~

Not a problem at all, I am just learning this stuff so I am struggaling along I am just glad there are people like yourself willing to help out.

:thumb

Tommy
09-04-2007, 02:55 PM
I hesitate to post when I am stuck in the 2000i world.
So with that being said, you have to have Model space and at least one Paper space. As already posted.

Why use scripting? Why not use DIR? IMHO having the reference to MS scripting adds overhead that is not neccessary.

lucas
09-04-2007, 02:57 PM
Hi Tommy,
How's the hurricane belt?

Tommy
09-04-2007, 07:06 PM
Hey Steve,

Everything's going South of me so far. I am prepared though. I can last a week primitive. After that I start getting worried. :)

No Gas, No Power, No Computer, :(

Guess I'll just have to go fishing :)

RMS
09-05-2007, 04:24 AM
.....Why use scripting? Why not use DIR? IMHO having the reference to MS scripting adds overhead that is not neccessary.

Can I find info on "DIR" in AutoCAD2005 VBA help? because I am not familiar with this.

Tommy
09-05-2007, 06:48 AM
This is how I would have done the request. This will search the whole directory for dxf files, open them, add a layer, change some things about the layer, deleting all paper space, and save with another file name.

Sub FixMyDXF()
Dim mPath As String, mFileName As String, mNewLyr As AcadLayer
Dim mDoc As AcadDocument, sset As AcadSelectionSet
mPath = "D:\Rob_Souza\Poly\VBATEST\"
mFileName = "*.dxf"
mFileName = Dir(mPath & mFileName)
While mFileName <> ""
Set mDoc = Application.Documents.Open(mPath & mFileName)
DeleteLayouts mDoc
Set mNewLyr = mDoc.Layers.Add("LayerName")
'set layer attributes
mNewLyr.Color = acRed
mNewLyr.Linetype = "CONTINUOUS"
Set sset = mDoc.SelectionSets.Add("TEST")
mDoc.Export Replace(mPath & mFileName, ".DXF", "Rev"), "DXF", sset
mDoc.Close False
Set mDoc = Nothing
Set mNewLyr = Nothing
mFileName = Dir
Wend
End Sub
'Below contributed by lucas :D
Sub DeleteLayouts(iDoc As AcadDocument)
Dim adLayout As AcadLayout
On Error Resume Next
If iDoc.ActiveSpace = acPaperSpace Then _
iDoc.ActiveSpace = acModelSpace
For Each adLayout In iDoc.Layouts
adLayout.Delete
Next adLayout
Err.Clear
On Error GoTo 0
End Sub

RMS
09-05-2007, 08:05 AM
Tommy, nice job but is there a way to overwrite the existing file name? I have to keep this name the same. I have tried tweaking the code all kinds of ways but it wont overwrite ....

Tommy
09-05-2007, 08:22 AM
I thought it was a one line change but it was 3.
If there is anything you don't understand I will be more than happy to explain.

Sub FixMyDXF()
Dim mPath As String, mFileName As String, mNewLyr As AcadLayer
Dim mDoc As AcadDocument, sset As AcadSelectionSet, mFxdNm As String
mPath = "D:\Rob_Souza\Poly\VBATEST\"
mFileName = "*.dxf"
mFileName = Dir(mPath & mFileName)
While mFileName <> ""
Set mDoc = Application.Documents.Open(mPath & mFileName)
DeleteLayouts mDoc
Set mNewLyr = mDoc.Layers.Add("LayerName")
'set layer attributes
mNewLyr.Color = acRed
mNewLyr.Linetype = "CONTINUOUS"
Set sset = mDoc.SelectionSets.Add("TEST")
mFxdNm = Replace(mPath & mFileName, ".DXF", "Rev")
mDoc.Export mFxdNm, "DXF", sset
mDoc.Close False
'copy new file over exist file
FileCopy mFxdNm & ".DXF", mPath & mFileName
'delete the new file
Kill mFxdNm & ".DXF"
Set mDoc = Nothing
Set mNewLyr = Nothing
mFileName = Dir
Wend
End Sub

EDIT: Changed the Path to the one posted

RMS
09-05-2007, 08:44 AM
I thought it was a one line change but it was 3.
If there is anything you don't understand I will be more than happy to explain....

Thanks Tommy that did the trick, wow there is a lot to this stuff! One question though; what is this all about:

Set sset = mDoc.SelectionSets.Add("TEST")

On a side note, tonight is my first class in C++, I wanted VB but it is not available this semester. I use AutoCAD alot so I need to know how to code it!

Thanks again,
Rob

Tommy
09-05-2007, 09:00 AM
The sset is a selection set which has to be there for the export option to work. It is ignored (according to help) and I don't understand why it is neccessary unless internally they fill it and export it.

LOL C++ is arx in acad. It is actually an external program loaded into acad memory space. You'll need a SDK for that. Have you tried Lisp? Have you learned how to customize the menus?

lucas
09-05-2007, 09:12 AM
LOL C++ is arx in acad. It is actually an external program loaded into acad memory space. You'll need a SDK for that. Have you tried Lisp? Have you learned how to customize the menus?
Hi Tommy, Rob will be taking advantage of your signature line if you keep this up :devil2: Not sure he knows what he's getting himself into.

RMS
09-05-2007, 09:19 AM
The sset is a selection set which has to be there for the export option to work. It is ignored (according to help) and I don't understand why it is neccessary unless internally they fill it and export it.

Oh ok I know what you mean!



LOL C++ is arx in acad. It is actually an external program loaded into acad memory space. You'll need a SDK for that. Have you tried Lisp? Have you learned how to customize the menus?

I have not tried Lisp other than some examples and as far as menues, I just use the icons unless I have to use a menue option so no, I have not done any customizations to them.

I have heard about arx but not sure what it is and I don't know what SDK is.......:think:

RMS
09-05-2007, 09:27 AM
Hi Tommy, Rob will be taking advantage of your signature line if you keep this up :devil2: Not sure he knows what he's getting himself into.

You may be right, ..........I may be crazy...........and swearing is not optonal at least this is what the programer that sits next to me says!

:bug:

Tommy
09-05-2007, 09:34 AM
LOL You are fixing to step off into some real fun. :)
SDK: Software Development Kit

LOL Hey Steve, I don't have to smack'em around any. I melt the math co-processors :D

RMS
09-05-2007, 09:44 AM
LOL You are fixing to step off into some real fun. :)
SDK: Software Development Kit

LOL Hey Steve, I don't have to smack'em around any. I melt the math co-processors :D

Yeah tonight is my first class! I am starting to get nervious now though.....LOL

So then, if I learn some basics in my C++ class and I get a SDK what will I be able to do in Autocad for programing?

lucas
09-05-2007, 09:55 AM
LOL You are fixing to step off into some real fun. :)
SDK: Software Development Kit

LOL Hey Steve, I don't have to smack'em around any. I melt the math co-processors :D

math co-processor!......you're telling your age.

Tommy
09-05-2007, 10:39 AM
math co-processor!......you're telling your age.
LOL look whos talking, you have to be old as me to know that!! Besides that it's skill to melt the Math Co-processor now that is part of the CPU!


So then, if I learn some basics in my C++ class and I get a SDK what will I be able to do in Autocad for programing?

With a lot of patience and a lot of reading anything you want.

RMS
09-05-2007, 10:56 AM
...With a lot of patience and a lot of reading anything you want.

Very interesting stuff! So I have my C++ book now but I suppose I will need a book about AutoCAD's ObjectARX is there an ObjectARX book that you can recomend?

Tommy
09-06-2007, 06:02 AM
I don't have to go that deep (ObjectARX), at least right now. :)

But the documentation fram autodesk is very good. Most of the time you can use their examples straight from the help/documentation. Otherwise visit the newsgroups for autodesk.

How was your first lesson?

RMS
09-06-2007, 06:57 AM
....How was your first lesson?

It went ok, it was just an overview of all things to come, the teacher stressed that we will do alot with memory. He also said with C++ we will have full control of the CPU as well.

Tommy I have a question, I have a strange problem now trying to load my VBA projects in AutoCAD, after I load them and I have it up on the screen in the VB editor they wont run as usual but instead the load macro dialog box opens up and nothing in it seems to work, any ideas on this problem or how to fix it?

Edit: Its working now but its acting strange but it should be ok.....

Thanks,
Rob

lucas
09-06-2007, 09:04 AM
Hi Rob,
Are you saving your projects as external files with a .dvb file extention?

RMS
09-06-2007, 09:41 AM
Hi Rob,
Are you saving your projects as external files with a .dvb file extention?

Well....I think I am; they are being saved in a folder and with a .dvb extention.

lucas
09-06-2007, 10:35 AM
and if that directory is in your support file search path...if not add it.

Tools-options-
select the files tab at top
click the x or + sign to the left of "Support file search path"
then on the right side select browse to add your directory to the list.

Then they are available every time you run cad and you can add buttons to a new or existing toolbar to run them...right click on any menu and select customize.

code for the button:
-vbarun;nudge.dvb!nudge;
nudge.dvb is the name of the file & nudge; is the name of the module

RMS
09-06-2007, 12:09 PM
and if that directory is in your support file search path...if not add it.

Tools-options-
select the files tab at top
click the x or + sign to the left of "Support file search path"
then on the right side select browse to add your directory to the list.

Then they are available every time you run cad and you can add buttons to a new or existing toolbar to run them...right click on any menu and select customize.

code for the button:
-vbarun;nudge.dvb!nudge;
nudge.dvb is the name of the file & nudge; is the name of the module

The File path were there but I added them again just in case, I think one of my custom buttons to load the application got corrupted so I made another button.

I tried what you suggested but It did not work, first thing is I am not sure what the "Module" is called if any, I just have a file name but I tried this, am I on the right track?

Edit: One problem I am still having is say, when I used to go file, open, I would normally get a dialog box in a window, then search through that BUT now it asked for a drawing name at the command line? .......some setting is messed up and I can't seem to find it.

lucas
09-06-2007, 01:11 PM
The image goes with this code which is in the attext.dvb
The name of the module is ExtractBOM

Option Explicit
Sub ExtractBOM()
'some code goes here
End Sub

RMS
09-06-2007, 01:23 PM
Shoot......hey Lucas thanks a bunch for the help I will give that a try, I would have never guesed that!

Rob

lucas
09-06-2007, 01:23 PM
Edit: One problem I am still having is say, when I used to go file, open, I would normally get a dialog box in a window, then search through that BUT now it asked for a drawing name at the command line? .......some setting is messed up and I can't seem to find it.
Type this at the command line:
FILEDIA

If it's set to zero then something has changed it. Make sure it's set to 1 and then try it.

RMS
09-06-2007, 01:30 PM
Type this at the command line:
FILEDIA

If it's set to zero then something has changed it. Make sure it's set to 1 and then try it.

Yeah it was set to "0" I put it back to 1.

Thanks

P.S. Messing with the Custom Button Icons right now

Edited: Buttons now load the .dvb macros! Now I am back on track!

Thanks Again, you guys are great!

RMS
09-06-2007, 02:01 PM
Hey Lucas, are you a guitar player?

lucas
09-06-2007, 02:20 PM
I have an acustic Alvarez that I've had since 1969. My youngest son Ben who is 22 and I play almost every day. We have guitars, amps, pa, drums, etc. here and get together with friends and sometimes have a drink. It's a lot of fun. The boys had a band for a while but college got in the way. We homeschooled the kids so he had to figure out some way to deal with me.

Tommy
09-06-2007, 04:11 PM
LOL well I see everything is in order.

@ Rob

Oh please tell me why, just WHY did you have to ask about that?!?!!?!?!??
DON'T talk about THAT!!!!!!

It'll be DAYS before he quits!!!!!

HAHA just poking some fun.

lucas
09-06-2007, 04:38 PM
He should not have opened that door...

Zrob
09-06-2007, 04:38 PM
Once again I forgot my password at work for RMS! But I got so envolved with this VBA stuff then when I noticed the white Les Paul!


I have an acustic Alvarez that I've had since 1969. My youngest son Ben who is 22 and I play almost every day. We have guitars, amps, pa, drums, etc. here and get together with friends and sometimes have a drink. It's a lot of fun. The boys had a band for a while but college got in the way. We homeschooled the kids so he had to figure out some way to deal with me.

Alvarez, thats a nice guitar, as for the LP as well! I have a 1985 Gibson Les Paul Deluxe, two acoustics, a 1995 Fender Strat USA, and a Mashall half stack, and a few home made tube amps. One Tube amp I made is reved up for doing hard rock, no pedels needed!


LOL well I see everything is in order.

@ Rob

Oh please tell me why, just WHY did you have to ask about that?!?!!?!?!??
DON'T talk about THAT!!!!!!

It'll be DAYS before he quits!!!!!

HAHA just poking some fun.

LOL :dunno I didn't mean to......LOL

lucas
09-06-2007, 04:47 PM
My les Pauls got away from me when we started having kids....for some reason I thought I didn't need them anymore. I also had a 1969 red and yellow sunburst Les Paul.

Fender Twin for amp...tube of course. The kids made fun of me till they got into it a little.

I'm old school rock...Zep, Floyd, Eagles...
I have had to learn some newer stuff though. Weezer, Perl Jam, green day, etc. which aren't the newest I know.
So reved up tube amp....like feedback eh?

Zrob
09-06-2007, 04:54 PM
.....Fender Twin for amp...tube of course. The kids made fun of me till they got into it a little.

I'm old school rock...Zep, Floyd, Eagles...
I have had to learn some newer stuff though. Weezer, Perl Jam, green day, etc. which aren't the newest I know.
So reved up tube amp....like feedback eh?

Sweet! Fender amps are great! Do you like tweed? Here is a link to my projects page and that amp:

www[dot]dreamtone.org/Mini_JCM800_2204.htm#1

I call this the mini jcm it has one 12" speaker, 3 pre amp tubes and two EL84's for the power tubes. All in the size of a Blues Jr.

Zrob
09-06-2007, 05:03 PM
Fender 5E7 sound bite from one of my builds here:

www[dot]dreamtone.org/BluesRock1.mp3

Tommy is going to kick me out if I keep this up....LOL

so I am off to do some C++ home work!

Peace!
Rob

lucas
09-06-2007, 05:07 PM
Do you play in public? Band, open mike night, etc.

Tommy will probably kick us both out.
Later

RMS
09-07-2007, 04:59 AM
Do you play in public? Band, open mike night, etc.

Tommy will probably kick us both out.
Later

No, I used to 20 years ago but now with two young kids its kinda tough and working full time, going to school at night, so the playing is now on a back burnner.