TheSwamp
Code Red => VB(A) => Topic started by: rugaroo on December 23, 2003, 06:01:59 PM
-
Well I am working on something here and I wanted to see if you guys saw any true use for this or if it may be a waste of time.
Psuedo Code / Idea:
1. User has a popup box like this:
(http://theswamp.org/lilly.pond/rugaroo/insmul.bmp)
2. In the dwg info spot, current dwg ltscale is shown, along with snapang and clayer.
3. Below that is something called 'Blocks'. Here is where all blocks in current dwg are listed (alphabatized).
4. Ins. Layer - Pick the layer that you want all of your blks inserted on to. (Hides xref layers and binds)
5. Uniform Ang. - If user checks the unif. ang. box, this will become active and allow the user to specify a uniform angle for all blks inserted from this prog.
6. New layer name - If user checks 'Create New Layer' this will become active and allow the user to type in a new layer name and ins all blks to that layer.
7. Allow MIRRTEXT - only useful if unif ang is not selected. Allows user to rotate the blocks and have them automatically mirror if needed.
8. Block Preview - previews the blk if a preview is present.
Now I created the form in the VBA module, but have nothing that works...I know nothing of the devil and his ways ;). Do you guys feel that this could be useful or just a fancy way of inserting for beginners?
Let me know what you guys think so I can try to start and write some code for this if this is something worth while doing.
Rug
-
Only if I can select multiple blocks within a folder and have it insert each block, wherever I select it. BTW Rug, you're allowed to vote too.
-
Ok...so multiple blk support, and a browse ability...that shouldn't be too hard. I don't think that it will be at least. Well so far...it doesn't sound to be too much to try for.
-
Anything that there is a use for AND that someone would use AND that make the job easier AND/OR that makes the faster AND/OR makes the job more accurate are always welcome in my book.
The amount of coding in many programs is seen many times as entirely too much for the end result, but it has been my experience that any bit of code that saves say 2 minutes each drawing and can be reused 3 to 5 times a day or more and makes the job more accurate is certainly worth the effort. The reason is that once the program is written it becomes part of your regular tool kit and you would become more dependent upon it, and find more uses for it. While becoming dependant on a program is not readily viewed as a positive thing by most people, I submit that it is positive in that if you adhere to a set of standards and can then create a series of programs to do larger and increasingly difficult tasks, you reduce the margin of error and increase productivity, not to mention the increased worker satisfaction.
Go for it. Make it work real good...
-
go for it !
I agree with Keith's statements.
and if nothing else... you'll learn a bt about VBA so whatever happens you'll have stepped forward in the autocad scheme of things. (BTW shouldn't this post be in the VBA forum ? it's kinda lonely in there :cry: )
one thing I would like to add is that while you have designed your proggy with specific functions at the moment, you could well find that will change as you develop your programme. And even after you've completed it, you'll probably revisit it to make amendments/additions etc at a later date.
I have a prog here that I wrote about two years ago. I use it at least several times a day and only last week I had a brainwave and made an addition to it ~ saved myself another 15 seconds per dwg !
BTW, you may want to add a "scale" factor in there too
-
Ok it seems as though I have a good amount of you wanting to see what can become of this now. As to answer your question Hendie 'BTW shouldn't this post be in the VBA forum ?'..I was thinking that, but there are two ways that I can to this...DCL and VBA...granted the two are completely different, but can accomplish some of the same tasks as one another. Then also about you scale idea...I am going to have to add this...I originally was thinking that I could just use ltscales to determine the scales, but not everyone is CADliterate as some of us may or may not be. Now I will admit that this is going to be my first attempt with anything in VBA...I am getting ready to head over to Afra and Stig's websites to start looking around for some examples and possibly ideas on home to make this fall together. Again guys, I appreciate the help and encouragement.
Rug
-
Ok...I have been sitting here working on the prog, and ran into something that is bugging me.
Here is the code that I have for my drop down to show all of the layers in a dwg.
Private Sub ComboBox1_DropButtonClick()
Dim AllLayers As Object
Dim Layer As Object
'declare local variables
Set AllLayers = ThisDrawing.Layers
'get the layers from the layers collection
For Each Layer In AllLayers
'For each layer ->
ComboBox1.AddItem Layer.Name
'Add layer name
Next
End Sub
The problem is, is that if I click the drop button more than once...well it adds the layers again and again and....well you get the point.. how would I sneek around this? I tried to chand from ComboBox1_DropButtonClick() to ComboBox1_Click() and a few others, but nothing else does what is needed...any advice?
Rug
-
Well Here is what I have to this point. I have posted some screen shots that way you can see what I mean. Also here is the code. I really feel that this being my first VBA project, I am doing pretty darn well. The code that is used for the user name retrieval is from cadencoding.com. So here it is..I will post some questions after the pics.
(http://theswamp.org/lilly.pond/rugaroo/V01B0.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V01B1.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V01B2.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V01B3.bmp)
Private Sub CDSlink_Click()
Dim nFile As Integer
nFile = FreeFile
Open "\TEMP.URL" For Output As #nFile
Print #nFile, "[InternetShortcut]"
Print #nFile, "URL=http://www.civildraftingservices.com"
Close #nFile
'Launch the browser
Shell "rundll32.exe shdocvw.dll,OpenURL " & "\temp.url", vbNormalFocus
'Delete the temp file
Kill "\TEMP.URL"
End Sub
Private Sub ComboBox1_DropButtonClick()
Dim AllLayers As Object
Dim Layer As Object
'declare local variables
Set AllLayers = ThisDrawing.Layers
'get the layers from the layers collection
For Each Layer In AllLayers
'for every layer listed
ComboBox1.AddItem Layer.Name
'add the layer name to the list box
Next
End Sub
Private Sub ComboBox2_DropButtonClick()
Dim AllBlocks As Object
Dim objEnt As Object
Dim objBlks As Object
Dim objBlk As Object
Set AllBlocks = ThisDrawing.Blocks
For Each objBlk In AllBlocks
ComboBox2.AddItem objBlk.Name
Next
For Each objEnt In AllBlocks
ComboBox2.AddItem objEnt.Name
Next
For Each objBlks In AllBlocks
ComboBox2.AddItem objBlks.Name
Next
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub Label6_Click()
Const NoError = 0 'The Function call was successful
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim status As Integer
' For getting user information.
Dim lpName, lpUserName As String
Set UsersName = ThisDrawing.Application
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
' Display the name of the person logged on to the machine.
UserString = Val(lpUserName)
Label6.Caption = lpUserName
End Sub
Private Sub Swamplink_Click()
Dim nFile As Integer
nFile = FreeFile
Open "\TEMP.URL" For Output As #nFile
Print #nFile, "[InternetShortcut]"
Print #nFile, "URL=http://theswamp.org"
Close #nFile
'Launch the browser
Shell "rundll32.exe shdocvw.dll,OpenURL " & "\temp.url", vbNormalFocus
'Delete the temp file
Kill "\TEMP.URL"
End Sub
Private Sub UserForm_Click()
End Sub
And my questions as always.
1. As you notice between the first and second image, the user name show up, but you must click it...how do I get it to show up at the start instead?
2. Each Time I click on the Layer/blks pulldowns, it loops and keeps adding each time you click it. How do I fix it to stop after one click?
And the biggest question of all...How am I doing so far for just a little encouragement??? Any more requests?
Thx - Rug
-
Hey rugaroo,
Splendid job! It's a bad idea to populate dropdowns or listboxes when clicking on/in them. The initial population should be done in the form's Initialize sub.
Only if adding to the lists, you should change the contents but that task should also be done from the 'outside'. For example, if you're adding via a subdialog or an edit field you should let the object that submits the changes edit the content of the lists.
To make it short, clicks in comboboxes should only handle choice of item, not population.
-
To elaborate, create an Initialize sub for your form like below. Notice that blocks are scanned for type - you wouldn't want layout blocks to appear in the dropdown!
Private Sub UserForm_Initialize()
Dim AllBlocks As Object
Dim objBlk As Object
Dim AllLayers As Object
Dim Layer As Object
'declare local variables
Set AllLayers = ThisDrawing.Layers
'get the layers from the layers collection
For Each Layer In AllLayers
'for every layer listed
ComboBox1.AddItem Layer.Name
'add the layer name to the list box
Next
Set AllBlocks = ThisDrawing.Blocks
For Each objBlk In AllBlocks
'we don't want layout blocks!
If Not objBlk.IsLayout Then
ComboBox2.AddItem objBlk.Name
End If
Next
End Sub
*now see what you did? I hate that VB language! (reminds me of V*ginal Burb)*
-
Oh by the way. The first question you have is also because you use a click sub to set the username. Put it into the form initializing sub.
As another note, I like to declare external procedures explicitly instead of or in addition to referencing them. That way you know where they are coming from. In your code, the WNetGetUser function comes from out of town, so I would:
1. Declare where it's coming from (see below)
2. Use it in a separate function (also see below)
Alternatively to WNetGetUser, you can use the WScript object in Windows. It can be used for some good information. For example, the WScript.NetWork keeps the username. In the sub below, I've added both WNetGetUser and WScript.
'Declare for WNetGetUser:
Private Declare Function WNetGetUser Lib "Mpr.dll" _
Alias "WNetGetUserA" _
(ByVal lpName As String, _
ByVal lpUserName As String, _
lpnLength As Long) As Long
'Function to find userName with WNetGetUser:
Private Function getUserName() As String
Const NoError = 0 'The Function call was successful
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim status As Integer
' For getting user information.
Dim lpName, lpUserName As String
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
' An error occurred.
lpUserName = ""
End
End If
getUserName = lpUserName
End Function
'Sample Initialize sub for Form:
Private Sub UserForm_Initialize()
Dim AllBlocks As Object
Dim objBlk As Object
Dim AllLayers As Object
Dim Layer As Object
Dim WScriptObj As Object
'declare local variables
'just in case you didn't set the label field
'to empty by default
Label6.Caption = ""
On Error GoTo noWScriptObject
Set WScriptObj = CreateObject("WScript.Network")
Label6.Caption = WScriptObj.Username
'additional info from the WScript.Network object could
'e.g. be (don't go overboard in needless info, though):
'Label7.Caption = WScriptObj.ComputerName
'Label8.Caption = WScriptObj.UserDomain
noWScriptObject:
'here you would call getUserName if you don't
'want to use or have troubles using the WScript
'object
'Label6.Caption = getUserName
Set AllLayers = ThisDrawing.Layers
'get the layers from the layers collection
For Each Layer In AllLayers
'for every layer listed
ComboBox1.AddItem Layer.Name
'add the layer name to the list box
Next
Set AllBlocks = ThisDrawing.Blocks
For Each objBlk In AllBlocks
'we don't want layout blocks!
If Not objBlk.IsLayout Then
ComboBox2.AddItem objBlk.Name
End If
Next
End Sub
*still hating this stoopid language*
-
Stig -
Thanks for the corrections. I will have to take a look at that and try to implement it in. I may have some questions regarding you comments, and what not, but that won't be until later...
Thx a lot,
Rug
-
Rug there is an enhancement I can see that might be kinda nice to have... If you include the VoloView AvViewX.dll you canhave a much better drawing preview. It is a little slower, but it gives you the entire drawing in a much better view along with the volo view commands in the preview.
Place a AvViewX control on the form and use this code to manipulate it.
To get the AvViewX control on the controls toolbox, right click on the toolbox and select additional controls, then check the Autodesk Volo View Control.
AvViewX1.src = FullPath
AvViewX1.ZoomExtents
AvViewX1.ControlTipText = FullPath
You will need to repaint the form after setting the values..
UserForm.Repaint
-
Here is the latest.
I have uploaded my dvb file, and some more screenshots. Another problem with the blocks pulldow though, it lists dimensions!!! I tried many ways to exclude them, including:
Set AllBlocks = ThisDrawing.Blocks
For Each objBlk In AllBlocks
If Not objBlk.DimStyles Then
ComboBox2.AddItem objBlk.name
End If
For Each objBlk In AllBlocks
'we don't want layout blocks!
If Not objBlk.IsLayout Then
ComboBox2.AddItem objBlk.name
End If
Next
But it still shows them and the gives me an error. What should I try? Also, the layers do not show up alphanumerically...is there a way that I can provide this?
KEB -
I like your point with the VoloView, but I will need some help with that a little later.
Stig -
See you were right, and it's amazing how simple my mistake was. Thank you.
insmul.dvb - http://theswamp.org/lilly.pond/rugaroo/insmul.dvb
(http://theswamp.org/lilly.pond/rugaroo/V02B1.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V02B2.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V02B3.bmp)
Maybe you guys can give me some more ideas, or pointers, at this point all would be great...
Rug
-
Problem is you are using two For Each loops try this.....
'initiate objBlk as a block
Dim objBlk As AcadBlock
'get all of the blocks defined
Set AllBlocks = ThisDrawing.Blocks
'now for every block
For Each objBlk In AllBlocks
'if the first character is not an asterisk
If Left$(objBlk.Name, 1) <> "*" Then
'add it to the combo box
ComboBox2.AddItem objBlk.Name
'end if evaluation
End If
'proceed to the next objBlk
Next objBlk
'release AllBlocks - this isn't necessary but I don't like leaving loose ends
Set AllBlocks = Nothing
Now you have no dimensions (*Dxx) , hatches (*Xxx), anonymous (*Uxx), paperspace (*PaperSpacexx), or modelspace (*ModelSpace) blocks to contend with. Cool huh...
-
I just had a thought....
Are you using a custom pointer on your links in the form? If not see this (http://theswamp.org/phpBB2/viewtopic.php?p=6083#6083) thread..
-
Let me ask you this though Keith, What if for some reason the pointer does not exist in the given directory? What would happen then?...Just curious...And thx for the block correction...Does just what is needed. Thx again...How do you think I am doing?
-
Ok I have found a tiny flaw in the code on the other page and I am going to fix it in a minute but here is an icon for you. Add this code to the project and call it in the form initialize event to write a cool little pointy finger icon. To use a different icon simply change the data to reflect the binary data of the cursor you want to use.
Sub WriteIcon()
Dim BD As Variant
Dim CurByte As Byte
Dim TempPath As String
' change the binary daya below to represent the file contents of your
' cursor. Remember to make sure to add the space at the end of each line
' so that we can step 3 without error to the data.
BD = "00 00 02 00 01 00 20 20 00 00 00 00 00 00 30 01 " & _
"00 00 16 00 00 00 28 00 00 00 20 00 00 00 40 00 " & _
"00 00 01 00 01 00 00 00 00 00 80 00 00 00 00 00 " & _
"00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " & _
"00 00 FF FF FF 00 00 00 00 00 00 00 00 00 00 00 " & _
"00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " & _
"00 00 00 00 00 00 00 1F FE 00 00 3F FE 00 00 7F " & _
"FE 00 00 7F FE 00 00 6F FE 00 00 6D B6 00 00 6D " & _
"B6 00 00 0D B6 00 00 0D B6 00 00 0C 00 00 00 0C " & _
"00 00 00 0C 00 00 00 0C 00 00 00 0C 00 00 00 00 " & _
"00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " & _
"00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 " & _
"00 00 00 00 00 00 FF FF FF FF FF FF FF FF FF FF " & _
"FF FF FF FF FF FF FF FF FF FF FF C0 01 FF FF C0 " & _
"01 FF FF C0 01 FF FF C0 00 FF FF 80 00 FF FF 00 " & _
"00 FF FF 00 00 FF FF 00 00 FF FF 00 00 FF FF 00 " & _
"00 FF FF 80 00 FF FF E0 00 FF FF E0 49 FF FF E1 " & _
"FF FF FF E1 FF FF FF E1 FF FF FF E1 FF FF FF E3 " & _
"FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF " & _
"FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF " & _
"FF FF FF FF FF FF "
On Error GoTo OutOfHere
'get the temp file location
TempPath = Environ("TEMP")
If TempPath = "" Then
TempPath = Environ("TMP")
End If
'open a file to write
Open TempPath & "/url.cur" For Binary Access Write As #1
'change 979 to the length of BD + 1 if you change the binary data
For X = 1 To 979 Step 3
'write out the data as hex
CurByte = "&H" & Mid$(BD, X, 2)
Put #1, , CurByte
Next X
OutOfHere:
'close the file
Close #1
End Sub
Ok, if the pointer doesn't exist you will crash miserably unless you have an error handler in there. Then it will simply not show up, but the original one will.
-
... Also, the layers do not show up alphanumerically...is there a way that I can provide this?
what you need is a sorting routine.. I have one I borrowed from somewhere, ~ I'll dig it out and post later.
I also have a "kill duplicates" routine stolen from the same source, that may be useful to you also.
-
Keith -
Thanks for the assistance with the blocks...That works great.
Now that I am on a clear train of thought, I will bring up a few questions.
1. Where could I find some example code to pry apart for my Mirrtext option. I want the check box to get the mirrtext var, then if it = 0 leave it alone, but if = 1 then change it to zero.
2. Where could I also find some example code to help me figure out the new layer box. I will have a check box, and entry field. If the new layer check box is unchecked the entry field is left blank. Then if the user checks the box and enters a new layer name, the layer will be created and set to current as soon as the user clicks the ok button...more will happen when the ok is clicked, but this is a generalization.
3. For your pointer Keith, should I place that under a module or the user form? Next, how would I tell the app to use the newly created cursor?
This is all I can think of for right now, but I am sure I shall have more.
Thx,
Rug
-
Rug,
Here's something that will help for No.1
Sub DT_Check()
Dim SysVarName As String
Dim serch As String
Dim fs As Variant
Dim a As Variant
Dim DT_text1 As String
SysVarName = "USERS2"
serch = ThisDrawing.GetVariable(SysVarName)
If serch = "set" Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\draftset.txt", True)
a.WriteLine ("set")
a.Close
SysVarName = "MODEMACRO"
DT_text1 = "Drawing Tracker - ON"
ThisDrawing.SetVariable SysVarName, DT_text1
Else
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\draftset.txt", True)
a.WriteLine ("idle")
a.Close
SysVarName = "MODEMACRO"
DT_text1 = "Drawing Tracker - OFF"
ThisDrawing.SetVariable SysVarName, DT_text1
End If
End Sub
Pick apart and use for what have you...
-
Rug...
1. Simply test the value of the check box with a click event. If it is checked it is True if it not checked it is False
As such....
Private Sub MirrText_Click()
If MirrText.Value = True Then
ThisDrawing.SetVariable "MIRRTEXT", 0
Else
ThisDrawing.SetVariable "MIRRTEXT", 1
End If
End Sub
2. Add a click event to the layer check box
Private Sub NewLayer_Click()
LayerTextBox.Enabled = NewLayer.Value
If NewLayer.Value = False Then
LayerTextBox.Text = ""
LayerTextBox.BackColor = &H8000000A
Else
LayerTextBox.BackColor = &H80000005
End If
End Sub
and add to the OK_Click event
Dim NewLay As AcadLayer
If LayerTextBox.Text <> "" Then
Set NewLay = ThisDrawing.Layers.Add (LayerTextBox.Text)
NewLay.Color = acRed 'or whatever
ThisDrawing.SetVariable "CLAYER", NewLay.Name
End If
3. You can put it in a module or in the Form code window.
In the Form_Initialize event add the following code...
WriteIcon
TempPath = Environ("TEMP")
If TempPath = "" Then
TempPath = Environ("TMP")
End If
URL1.MouseIcon = LoadPicture(TempPath & "/url.cur")
URL1.MousePointer = fmMousePointerCustom
In the Form code window place this code...
Private Sub URL1_Click()
Dim IEApp As WebBrowser
Set IEApp = CreateObject("InternetExplorer.Application")
IEApp.Visible = True
IEApp.Navigate URL1.Caption
End Sub
Ok I think that is all the damage I can do right now...
-
WoooHoooo!!! Thank you Keith...Those worked great!!! Sorry dcg, but Keith's were...well easier to dig through and figure out what was actually going on, being that this is my first VBA Prog. Thx any ways.
Well after the large amount of help, here are some new screenshots and most of all the new code. Let me know what you think, or if you have any suggestions as usual.
(http://theswamp.org/lilly.pond/rugaroo/V03B1.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V03B2.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V03B3.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V03B4.bmp)
(http://theswamp.org/lilly.pond/rugaroo/V03B5.bmp)
Code: http://theswamp.org/lilly.pond/rugaroo/insmul.dvb
Thx again,
Rug
-
here's the list sort and duplicate removal I mentioned.
(I wish I could remember who I stole them from)
Public Function KillDupes(lst As ListBox)
' by DanL (I think)
Dim i As Integer
i = 0
Do While i < lst.ListCount
lst.Text = lst.List(i)
If lst.ListIndex <> i Then
lst.RemoveItem i
Else
i = i + 1
End If
Loop
lst.ListIndex = -1
End Function
Public Function SortList(objListBox As ListBox)
' also by DanL (I think)
Dim var As Variant
Dim IntCnt As Integer
For IntCnt = 0 To objListBox.ListCount - 2
If objListBox.List(IntCnt) > objListBox.List(IntCnt + 1) Then
var = objListBox.List(IntCnt)
objListBox.List(IntCnt) = objListBox.List(IntCnt + 1)
objListBox.List(IntCnt + 1) = var
IntCnt = -1
End If
Next IntCnt
End Function
-
From just looking at it, your mirrtext seems to be reversed and I don't like the alert box telling me whether it's enabled or not. Checking it should mean that it will mirror the text and un-checking it should mean that it won't mirror (be normal looking).
-
Daron, I had given some thought to mirrtext and I have come to the conclusion that mirrtext is possibly the most confusing variable of all time (especially for new users) I would think that by default whenever you mirror a piece of text that it should retain it's readability, but in fact the default if mirrtext is set is that text is not readable, giving many users unexpected results until they learn how the variable works.
The fix is simply to change "False" to "True" in the mirrtext_check event. I would suspect that the alert box is simply a diagnostic tool and will not be included in the final version, particularly considering that there is not a userform.show call anywhere in the macro it certainly is not completed by any means.
-
Keith, many moons ago, you created a routine that would dynamically show the ltscale while scrolling a scroll bar, before applying it, you remember? Is there any way you could devise a function that would show an image of say a "B" when it's not selected and a mirrored "B" when it is selected? That would be cool.
-
why not make the label for mirrtext a graphic as opposed to a label and mirror the graphic when checkbox is ticked
(well 2 graphics and turn on off and one on as required if you know what I mean)
-
Yup, that is what I was trying to say. Thanks for the clarification A.
-
I think it should show an N to have a little fun with the Russians.
-
How about this...I will place a small green circle for when it is 'on', and a red one for when it is off. that way it is apparent. it is either that or like the mirrored text idea....I will see what lloks neat and have you guys tell me.
Rug
-
I think it should show an N to have a little fun with the Russians.
That's funny. You might even be able to use unicode to produce it too.
Rug, red and green might be just as confusing as 0 and 1. What does it mean again? Visual minus directions, that's the way to go.
-
The procedure is simple enough, but it will entail placing a picture in the code from your end, in essence I cannot do it for you, but I can direct you about how to do it. Is that clear?
-
Keith,
I would appreciate the help. Give me a bit and let me see if I can come up with something by lucnh time here, and we can see what happens. Thanks
Rug
-
In AutoCAD
create a graphic of the text you want to represent mirrored text
make the modelspace background white
zoom extents on the text
export the text object to a bitmap
set mirrtext to 1
mirror the text
zoom extents on the text
export the text object to a bitmap
Now you have two distinct bitmaps
In your form add an image near your check box call it image1
Attach the bitmap to image1
Create an additional image call it image2 directly on top of image1 the same size as image1
Attach the other bitmap to image2
Set the visible attribute of image2 to false
In the mirrtext_click event add this in each of the if then conditions changing the true and false around to match the procedure call at the moment..
Image1.visible = False
Image2.visible = True
In the form initialize event make sure the correct image is visible according to the value of mirrtext and the checkbox and set the visible attribute of the other image to false.
-
Keith thanks...that will get me started...give me a bit to see if I can get it to work, and if so, I will post a screen shot for all to see and judge...
Thx
Rug
-
why not take a screenshot of your form and trim the image to the label part and save that image. mirror it and save again.
that way it would like you were mirroring the text on the form
-
I had thought of that hendie, in fact, you can apply an image as the text portion of the checkbox. In the properties window select the checkbox and apply the image. The only drawback is that to replace the image, you would either need to have 2 checkboxes or ship the images with the dvb file.
-
How would this be?
(http://theswamp.org/lilly.pond/rugaroo/mirr1.bmp)
(http://theswamp.org/lilly.pond/rugaroo/mirr2.bmp)
Seems kinda big and all...I am thinking like a little light would be good with like on/off next to it...granted it doesnt show what would actually happen, but honestly if you are clicking the option you would hopefully know what it means. :)
Also, on any of my links now, when I click on them, talk about a horrible crash...any ideas?
Rug
-
Well upload the latest code and let me have a look at it..
-
Post the code. Nobody could figure it out otherwise, methinks.
-
Sorry...Here it is.
http://theswamp.org/lilly.pond/rugaroo/insmul.dvb
Rug
-
Well it seems to work fine for me...I think that perhaps the file you are writing out for the URL is getting lost in the shuffle, try writing it to a specific path and retrieve it from the specific path.. You could also use the code I provided to open it in IE, or better yet get the registry data regarding which http program is the default and use it. Of course it might not work in all instances.
-
That "E" looks like you rotated it, instead of mirroring it, try using something smaller, like a lower case "mir". Although people should actually know what the heck the variable does, it really seems quite redundant to have a graphic representation of the toggle switch, when its right there in front of you (i.e. checked off means ON, not checked off means OFF).
-Theres my 0.333 cents worth-
-
Are those images backwards? Looks like the flipped E is for no mirrtext...you could also just change the text to "MIRRTEXT On"?
-
Mirrtext 1 is on and should mirror the text.
Mirrtext 0 is off and should leave the text readable by left brained people.
The way it appears is:
Mirrtext 1 is off
Mirrtext 0 is on
As far as the image goes, I was thinking something more along the lines of:
Mirrtext 1 = checked = on = EE <-as if it were an image
Mirrtext 0 = unchecked = off = E3 <-as if it were a mirrored E
-
If you want to distribute this, I would suggest this:
For text to be mirrored = mirrtext 1
( ) Text will be mirrored
For text not to be mirrored = mirrtext 0
(/) Text will not be mirrored
Using separate raster images for each of the corresponding states of mirrtext. You will have to include the images with the file when distributing. This will eliminate any confusion, as in what is happening to me at the moment. :?
-
You will have to include the images with the file when distributing
That is true unless he attaches the images to different controls in the form at design time.
For example at design time he can create image1 and image2 and attach E to one and 3 to one, then simply change the visibility of the image control in the form instead of reloading the image each time.
If you download the proggie as completed up to this point then run the user form and select the mirrtext toggle you will see what I am talking about...plus there are no extra images to have to deal with.
-
This will eliminate any confusion, as in what is happening to me at the moment. :?
I like the way you cleared that one up, peanuts for you! Wait, wrong forum! Don't ban me... :P
-
Don't ban me...
Never...
-
I think we need the gater rater up and running.
-
Wasn't t-bear supposed to get that thing going....or was that you ... heck it was so long ago that I completely forgot about it.
-
It was Hendie. I think the balls back in Mark's court though.
-
>I think the balls back in Mark's court though.
http://theswamp.org/swamp.files/Public/GreenGator1.gif
http://theswamp.org/swamp.files/Public/GreenGator2.gif
http://theswamp.org/swamp.files/Public/GreenGator3.gif
http://theswamp.org/swamp.files/Public/GreenGator4.gif
http://theswamp.org/swamp.files/Public/GreenGator5.gif
take your pick.
-
(http://theswamp.org/swamp.files/Public/GreenGator5.gif)
Maybe I'm too nice, but that would be my pick.
-
Here is what I am trying to get to happen now. When create new layer is clicked, I want the layer drop down to lock, just like what we have for the new layer name box.
Here is what I have tried, but it doesn't work...any ideas how I could better this?
ComboBox1.Locked = CheckBox3.Value
If CheckBox3.Value = True Then
ComboBox1.Enabled = False
ComboBox1.Locked = True
Else
ComboBox1.Enabled = True
ComboBox1.Locked = False
End If
Thx -
Rug
-
(http://theswamp.org/swamp.files/Public/GreenGator5.gif)
Maybe I'm too nice, but that would be my pick.
No, your just about right. I think. What is the sinco-reptilian graphic 's meaning?
-
If CheckBox3.Value = True Then
ComboBox1.Enabled = False
ComboBox1.BackColor = &H8000000A
Else
ComboBox1.Enabled = True
ComboBox1.BackColor = &H80000005
End If
This is all you need and you can add it to the same location as the other toggle for the layer edit box, making TextBox1.Enabled = True and ComboBox1.Enabled = False, you don't use locked in this instance.
-
Keith...Tried it, but it didn't do anything. That is why I was trying the lock. Any other ideas?
-
sinco-reptilian graphics? It's the first implementation of our rating system. I was kinda hoping it would be something that could be put under the user name or at the thread level in the forum block.
-
Sorry Keith...got it to work..Here is what I have added.
New Mirrtext toggle button:
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
ThisDrawing.SetVariable "MIRRTEXT", 0
ToggleButton1.Caption = "MIRRTEXT (On)"
ToggleButton1.ControlTipText = "M -> M"
Else
ThisDrawing.SetVariable "MIRRTEXT", 1
ToggleButton1.Caption = "MIRRTEXT (Off)"
ToggleButton1.ControlTipText = "M -> W"
End If
End Sub
Initialize:
ComboBox1.Enabled = True
ComboBox1.BackColor = &H80000005
TextBox1.Enabled = False
TextBox1.Text = ""
TextBox1.BackColor = &H8000000A
CheckBox3.Value = False
CheckBox3 (New Layer):
Private Sub CheckBox3_Click()
TextBox1.Enabled = CheckBox3.Value
ComboBox1.Enabled = CheckBox3.Value
If CheckBox3.Value = False Then
ComboBox1.Enabled = True
ComboBox1.BackColor = &H80000005
Else
ComboBox1.Enabled = False
ComboBox1.BackColor = &H8000000A
End If
If CheckBox3.Value = False Then
TextBox1.Text = ""
TextBox1.BackColor = &H8000000A
Else
TextBox1.BackColor = &H80000005
End If
End Sub
Looking pretty good so far. What do you think?
-
Post the code to this point and I will look at it.
-
Here is the latest and greatest code for y'all.
http://theswamp.org/lilly.pond/rugaroo/insmul.dvb
Rug
-
For some reason, I get a compile error on the last line here:
Private Sub UserForm_Initialize()
Dim AllBlocks As Object
Dim objBlk As AcadBlock
Dim AllLayers As Object
Dim Layer As Object
Dim WScriptObj As Object
'declare local variables
'just in case you didn't set the label field
'to empty by default
On Error GoTo noWScriptObject
Set WScriptObj = CreateObject("WScript.Network")
Label6.Caption = WScriptObj.UserName
'additional info from the WScript.Network object could
'e.g. be (don't go overboard in needless info, though):
'Label7.Caption = WScriptObj.ComputerName
'Label8.Caption = WScriptObj.UserDomain
noWScriptObject:
Set AllLayers = ThisDrawing.Layers
'get the layers from the layers collection
For Each Layer In AllLayers
'for every layer listed
ComboBox1.AddItem Layer.Name
'add the layer name to the list box
Next
Set AllBlocks = ThisDrawing.Blocks
For Each objBlk In AllBlocks
If Left$(objBlk.Name, 1) <> "*" Then
ComboBox2.AddItem objBlk.Name
End If
Next objBlk
Set AllBlocks = Nothing
'Displays ltscale
Label7.Caption = ThisDrawing.GetVariable("ltscale")
'Displays Current DWG Name
Label8.Caption = ThisDrawing.Name
'Displays current layer
Label10.Caption = ThisDrawing.GetVariable("clayer")
'Displays current snap angle
Label12.Caption = ThisDrawing.GetVariable("snapang")
WriteIcon
TempPath = Environ("TEMP")
Highlights Environ and alerts me "Can't find project or library".
-
Perhaps you don't have the type library installed. Let me see which one it is.
-
It's the VoloView. I didn't install it last time I installed Autocad, since I never use VoloView. Is it possible to get this for Autodesk Viewer? I looked at the references and found it checked and telling me it was missing:.
-
Anyone know how I would incorporate a browse function into a like a pull down or click option? I want something that has the shortcut things on the side too if possible. Just need some example code to tear apart or something.
Thx -
Rug
-
You could use the Win API Browse for Folder, but that won't allow you to see the files, SO ....
You could try this...
Option Explicit
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Sub GetFileName()
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFilter As String
OpenFile.lStructSize = Len(OpenFile)
strFilter = "AutoCAD Drawing File (*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & _
"AutoCAD Drawing Exchange File (*.dxf)" & Chr(0) & "*.dxf" & Chr(0)
With OpenFile
.lpstrFilter = strFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:\"
.lpstrTitle = "Select Drawing File"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "User cancelled"
Else
MsgBox "User selected" & ":=" & OpenFile.lpstrFile
End If
End Sub
Put it in a new module and call it from your browse button. Let me know if it is what you were expecting to see.
-
Is there any way to give that the ability to select multiple drawings?
-
Uh ... yes....
Change flags to the WinAPI Constant of
524288
This will return a list of selected drawings, but it will use the old style dialog.
If you use 524800 it will use the correct dialog and allow multiple files to be selected BUT they are separated by a null character and as such VBA cannot access them without a call to memory to grab the rest of the data.
I'll have to work on that.
-
Keith -
Thanks, that works great. Now when a user clicks a browse button this pops up. after the file is selected, I want the file name to be place into a text box.
this is what I have tried:
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OPENFILENAME.lpstrfile
End Sub
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OpenFile.lpstrfile
End Sub
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = GetFileName.lpstrFile
End Sub
And there were a few others too, but for some reason they all error out after selecting the file i want. For some reason it doesn't want to place the text...I think this is just a small minor mistake on my part, but not too sure. any suggestions?
Thx -
Rug
-
That is because the function is private. I will look at it a bit later and offer advice..
-
This won't work since OPENFILENAME is the typedef (don't worry about names just suffice it won't work)
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OPENFILENAME.lpstrfile
End Sub
This won't work since OpenFile is private AND contains all local variables
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OpenFile.lpstrfile
End Sub
This won't work since lpstrFile is not a member of GetFileName
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = GetFileName.lpstrFile
End Sub
So, how do we make it all work .....
First - Redefine the Sub GetFileName as a function. To do this replace
Sub GetFileName()
with
Function GetFileName()
AND
End Sub
with
GetFileName = OpenFile.lpstrfile
End Function
Now whenever you call GetFileName do it like this...
Private Sub CommandButton5_Click()
TextBox2.Text = GetFileName
End Sub
Now that GetFileName is a Function it will return a value. That value will be the file name.
I will be adding code to allow you to select multiple files IF you want to but I have to work out the string parsing routine.
Daron, try this and see if it gives you the desired results in an array:
'declare a variable to hold the array
Dim FileNames() As String
Dim X As Integer
Dim Y as Integer
'grab the path put it in 0
Redim Preserve FileNames(0)
FileNames(0) = OpenFile.lpstrfile
Y = 1
'Calculate the length of the string, You may need to increase the length of the string in the call, by increasing 257 to 4096
'grab length of lpstrFile and look at each item
For X = 1 to Len(OpenFile.lpstrFile)
' If the current item is NULL
If Mid$(OpenFile.lpstrFile, X, 1) = String(1,0) Then
'Add an additional object to the array
Redim Preserve FileNames(Y)
'Increment past the NULL character and grab the remaining
' by default the string will be truncated at the NULL character
FileNames(Y) = Mid$(OpenFile.lpstrfile, (X + 1), Len(OpenFile.lpstrFile))
'increment the file counter
Y = Y + 1
End If
' check the next item
Next X
Daron, I worte this on the fly so how about testing it for me and see how it works....
It will only work with Flags set to 524800
Also you will need to have some error checking to make sure the filename array is not expanded for null entries.
-
Ok here is a version that should work regardless of how you call it.
Option Explicit
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Const OFNAllowMultiselect = &H200
Public Const OFNCreatePrompt = &H2000
Public Const OFNExplorer = &H80000
Public Const OFNExtensionDifferent = &H400
Public Const OFNFileMustExist = &H1000
Public Const OFNHelpButton = &H10
Public Const OFNHideReadOnly = &H4
Public Const OFNLongNames = &H200000
Public Const OFNNoChangeDir = &H8
Public Const OFNNoDereferenceLinks = &H100000
Public Const OFNNoLongNames = &H40000
Public Const OFNNoReadOnlyReturn = &H8000
Public Const OFNNoValidate = &H100
Public Const OFNOverwritePrompt = &H2
Public Const OFNPathMustExist = &H800
Public Const OFNReadOnly = &H1
Public Const OFNShareAware = &H4000
Function GetFileName()
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim strFilter As String
Dim FileNames() As String
Dim X As Integer
Dim Y As Integer
Dim TempHolder As String
OpenFile.lStructSize = Len(OpenFile)
strFilter = "AutoCAD Drawing File (*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & _
"AutoCAD Drawing Exchange File (*.dxf)" & Chr(0) & "*.dxf" & Chr(0)
With OpenFile
.lpstrFilter = strFilter
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:\"
.lpstrTitle = "Select Drawing File"
.flags = OFNAllowMultiselect + OFNExplorer 'change per constants above
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
ReDim Preserve FileNames(0)
FileNames(0) = "User cancelled"
MsgBox "User cancelled"
Else
ReDim Preserve FileNames(0)
FileNames(0) = OpenFile.lpstrFile
Y = 1
For X = 1 To Len(OpenFile.lpstrFile)
If Mid$(OpenFile.lpstrFile, X, 1) = String(1, 0) Then
TempHolder = Mid$(OpenFile.lpstrFile, (X + 1), Len(OpenFile.lpstrFile))
If Left$(TempHolder, 1) <> String(1, 0) Then
ReDim Preserve FileNames(Y)
FileNames(Y) = TempHolder
Y = Y + 1
End If
End If
Next X
End If
GetFileName = FileNames
End Function
The calling syntax is:
ReturnValue = GetFileName
The function prototype is
RetVal = GetFileName() As Variant
RetVal is a variant array.
If a single file is selected then
RetVal(0) will have the File name including path
If multiple files are selected then
RetVal(0) will contain the path only and RetVal(x) will contain file names without the path.
-
Keith,
I tried what you had posted, but I keep getting an error for object required. I set it up the way you waid, but still the error. Any ideas?
I think that i will keep this to one block rather than multiple support for right now, and then add in future capabilities later. I have a few Ideas that I want to try and work out for this, but dont have the time to try them out just right yet. but i will soon.
Thx thus far,
Rug
-
upload the code and I will look at it.
-
Obviously, people have been quite a bit busier than normal around here. I am looking for some good books that any one might recommend right now for VBA and CAD. If I can find some good books, I would like to finish this project at least to an alpha stage of distribution. I also wanted to know how I would be able to port this around so that anyone that might want to use it can. Kinda like export a lsp to vlx...know what I mean now?... Thanks guys.