Poll

Will it work?

Yes
9 (100%)
No
0 (0%)
Why try?
0 (0%)

Total Members Voted: 5

Voting closed: December 28, 2003, 06:01:59 PM

Author Topic: Multiple Insert V0.1B  (Read 41509 times)

0 Members and 1 Guest are viewing this topic.

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Multiple Insert V0.1B
« Reply #60 on: January 08, 2004, 12:52:32 PM »
Sorry Keith...got it to work..Here is what I have added.

Code: [Select]
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?
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #61 on: January 08, 2004, 01:10:22 PM »
Post the code to this point and I will look at it.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Multiple Insert V0.1B
« Reply #62 on: January 08, 2004, 01:36:02 PM »
Here is the latest and greatest code for y'all.

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

Rug
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

daron

  • Guest
Multiple Insert V0.1B
« Reply #63 on: January 08, 2004, 01:52:36 PM »
For some reason, I get a compile error on the last line here:
Code: [Select]
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".

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #64 on: January 08, 2004, 01:59:44 PM »
Perhaps you don't have the type library installed. Let me see which one it is.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

daron

  • Guest
Multiple Insert V0.1B
« Reply #65 on: January 08, 2004, 02:07:59 PM »
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:.

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Multiple Insert V0.1B
« Reply #66 on: January 14, 2004, 12:03:57 PM »
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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #67 on: January 14, 2004, 02:19:47 PM »
You could use the Win API Browse for Folder, but that won't allow you to see the files, SO ....

You could try this...

Code: [Select]

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.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

daron

  • Guest
Multiple Insert V0.1B
« Reply #68 on: January 14, 2004, 03:02:03 PM »
Is there any way to give that the ability to select multiple drawings?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #69 on: January 14, 2004, 04:28:20 PM »
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.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Multiple Insert V0.1B
« Reply #70 on: January 14, 2004, 05:08:08 PM »
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:

Code: [Select]
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OPENFILENAME.lpstrfile
End Sub


Code: [Select]
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OpenFile.lpstrfile
End Sub


Code: [Select]
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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #71 on: January 14, 2004, 05:23:32 PM »
That is because the function is private. I will look at it a bit later and offer advice..
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #72 on: January 14, 2004, 06:28:46 PM »
This won't work since OPENFILENAME is the typedef (don't worry about names just suffice it won't work)

Quote

Code: [Select]
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OPENFILENAME.lpstrfile
End Sub



This won't work since OpenFile is private AND contains all local variables

Quote

Code: [Select]
Private Sub CommandButton5_Click()
GetFileName
TextBox2.Text = OpenFile.lpstrfile
End Sub



This won't work since lpstrFile is not a member of GetFileName

Quote

Code: [Select]
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
Code: [Select]

Sub GetFileName()


with

Code: [Select]

Function GetFileName()


AND

Code: [Select]

End Sub


with

Code: [Select]

GetFileName = OpenFile.lpstrfile
End Function


Now whenever you call GetFileName do it like this...

Code: [Select]

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:

Code: [Select]

'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.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Multiple Insert V0.1B
« Reply #73 on: January 15, 2004, 12:36:52 AM »
Ok here is a version that should work regardless of how you call it.

Code: [Select]

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.
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

rugaroo

  • Bull Frog
  • Posts: 378
  • The Other CAD Guy
Multiple Insert V0.1B
« Reply #74 on: January 16, 2004, 03:38:51 PM »
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
LDD06-09 | C3D 04-19 | Infraworks 360 | VS2012-VS2017