Topic: Multiple Insert V0.1B

[Keith™]

I just had a thought....
Are you using a custom pointer on your links in the form? If not see this thread..

[rugaroo]

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?

[Keith™]

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.

Code: [Select]


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.

[hendie]

... 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.

[rugaroo]

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

[deegeecees]

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...

[Keith™]

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....

Code: [Select]


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

Code: [Select]


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

Code: [Select]


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...

Code: [Select]


 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...

Code: [Select]


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...

[rugaroo]

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.











Code: http://theswamp.org/lilly.pond/rugaroo/insmul.dvb

Thx again,
Rug

[hendie]

here's the list sort and duplicate removal I mentioned.
(I wish I could remember who I stole them from)

Code: [Select]

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


Code: [Select]


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


[daron]

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).

[Keith™]

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.

[daron]

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.

[hendie]

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)

[daron]

Yup, that is what I was trying to say. Thanks for the clarification A.

[SMadsen]

I think it should show an N to have a little fun with the Russians.