Contact US

Question

AtoCAD, Access and VBA

PZero (IS/IT--Management)

(OP)

6 Aug 07 11:53

I have a drawing with several tabs. Each tab is named to match a record in my database, i.e. tab “R001” and record “R001”. The layout of each tab contains several blocks, each with several attributes. Each attribute’s tag is named to match a field name in my database, i.e. tag “FLOOR_AREA” and field “FLOOR_AREA”.

I am trying to put together a VBA app that will determine the current tab name and change the values of the attributes based on the related database record. This information does not need to be saved in the drawing, in fact it would be preferable to have the data accessed ‘on-the-fly’ so that the data viewed is the most recent.

I have hardly any VBA experience so I'm struggling a bit. I've learned quite a lot today, but still really have no clue on where to start with the code. I'm assuming it should be fairly basic, but I could be very wrong.

Thanks,
Chris

TCARPENTER (Programmer) · Answer 1 · 2007-08-06 15:15:45

Hi PZero,

Have a look at FAQ687-5800: How to connect AutoCAD to Access that should get you going on how to pull your attribute information from your blocks.

The next piece, just walking the drawing tabs, would look something like this:

CODE

Sub WalkLayoutTabs()
  Dim oLayout As AcadLayout

  For Each oLayout In ThisDrawing.Layouts
    Debug.Print oLayout.Name
  Next oLayout

End Sub

HTH
Todd

PZero (IS/IT--Management) · Answer 2 · 2007-08-06 17:16:24

Hi, thanks, but I'm trying to pull the data from access to add to the block attributes. Can I pick that up from that FAQ too?

TCARPENTER (Programmer) · Answer 3 · 2007-08-07 09:19:46

Hi PZero,

Yep. Instead of updating the recordset, you'll just need to read the recordset from Access, and then update the title block attributes.

Post back if you need more help.

HTH
Todd

PZero (IS/IT--Management) · Answer 4 · 2007-08-07 11:36:46

Hi Todd, thanks for getting back to me.

I tried the FAQ687-5800: How to connect AutoCAD to Access and its throwing back several errors. I have the title block in the drawing, then via VBAMAN load the DVB file I created, then via VBARUN I run the app. The following messages appear;

First, this error;
Error: -2147217887 - Index or primary key cannot contain null value.

Then this;
Error: 0 -

Then this;
Error: 20 - Resume without error.

Then it repeats errors 0 and 20 every time I click OK. I have to kill AutoCAD via the task manager and restert it.

I can see after going through the code that I can base my solution on it. I just need to get the basis of it working properly. I can upload my files if anyone can help?

PZero (IS/IT--Management) · Answer 5 · 2007-08-07 11:57:12

Ignore the last post, I have a few lines of code missing.

But with everything set up as per the FAQ except for paths, filenames, etc, I still receive an error;

Compile Error: Invalid use of property

It highlights one of the very last lines of 'Public Sub ExportAttribs()', the line being 'rstAttribs = Nothing'.

TCARPENTER (Programmer) · Answer 6 · 2007-08-07 12:13:43

Hi PZero,

Wow, that's a new one on me... For now, just comment it out, but it may need to read Set rstAttribs = Nothing

HTH
Todd

PZero (IS/IT--Management) · Answer 7 · 2007-08-07 12:24:27

Thanks Todd,

I changed those two lines near the end to;

Set rstAttribs = Nothing
Set cnnDataBse = Nothing

which has fixed the error 'Compile Error: Invalid use of property'.

It now comes up with the following error;

Error: -2147217887 - Index or primary key cannot contain null value.

I will take a look and see if I can find out more abou that error number.

PZero (IS/IT--Management) · Answer 8 · 2007-08-08 04:42:36

I had a look for information on the error message and couldnt see anything that immediately jumped out at me, so I'm just going to forget about that part of it. I think I'll be deleting that part of the code anyway, since all I want to do is read from the database, not write to it.

I'll keep you posted on my progress.

PZero (IS/IT--Management) · Answer 9 · 2007-08-08 07:06:52

Ok, I have started analysing and trying to make what I can of the code. After following the FAQ I have the following;

CODE

Public AcadDoc      As AcadDocument      'Current AutoCAD drawing document.
Public cnnDataBse   As ADODB.Connection  'ADO connection to database.
Public rstAttribs   As ADODB.Recordset   'ADO recordset to update.

Public Function vbdPowerSet(strName As String) As AcadSelectionSet

  Dim objSelSet As AcadSelectionSet
  Dim objSelCol As AcadSelectionSets
  Set objSelCol = ThisDrawing.SelectionSets
    For Each objSelSet In objSelCol
      If objSelSet.Name = strName Then
        objSelCol.Item(strName).Delete
        Exit For
      End If
    Next
  Set objSelSet = objSelCol.Add(strName)
  Set vbdPowerSet = objSelSet
End Function

Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())

  Dim fType() As Integer, fData()
  Dim index As Long, i As Long

  index = LBound(gCodes) - 1

  For i = LBound(gCodes) To UBound(gCodes) Step 2
      index = index + 1
      ReDim Preserve fType(0 To index)
      ReDim Preserve fData(0 To index)
      fType(index) = CInt(gCodes(i))
      fData(index) = gCodes(i + 1)
  Next

typeArray = fType: dataArray = fData

End Sub

Public Function Connect(strDatabase As String, strTableName As String)

  Dim strSQL As String  'SQL string for extracting recorsets.

  strSQL = "SELECT * FROM [" & strTableName & "]"

  Set cnnDataBse = New ADODB.Connection
  With cnnDataBse
    .CursorLocation = adUseServer
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Data Source").Value = strDatabase
    .Open
  End With

  Set rstAttribs = New ADODB.Recordset
  With rstAttribs
    .LockType = adLockPessimistic
    .ActiveConnection = cnnDataBse
    .CursorType = adOpenKeyset
    .CursorLocation = adUseServer
    .Source = strSQL
  End With

  rstAttribs.Open , , , , adCmdText

  If rstAttribs.RecordCount <> 0 Then
    rstAttribs.MoveFirst
  End If

End Function

Public Function AttribExtract(blkRef As AcadBlockReference)

  Dim vArray As Variant   'Attribute array.

  If blkRef.HasAttributes Then
    vArray = blkRef.GetAttributes
    AttribExtract = vArray
  End If

End Function

Public Sub ExportAttribs()

  Dim ssTitleBlock As AcadSelectionSet  'Selection set/title block to export.
  Dim intData()    As Integer           'DXF code for filtering.
  Dim varData()    As Variant           'DXF code description for filtering.
  Dim varAttribs   As Variant           'Attribute array from title block.
  Dim intAttribCnt As Integer           'Attribute array bounds.
  Dim fldAttribs   As ADODB.Field       'ADO fields from recordset.
  Dim strSearch    As String            'String to search for duplicates.
  Dim blnDuplicate As Boolean           'Duplicate record flag.
  Dim result       As VbMsgBoxResult    'User prompted responses.
  Dim strTblName   As String            'Name of Access table to populate.

  ' Defaults.
  '
  On Error GoTo ExportAttribs_Error
  strTblName = "tblDrawings"  ' Table name in database.
  Set AcadDoc = ThisDrawing   ' Current drawing.

  ' Build the filter criteria.
  '
  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "TitleBlock", _
                                -4, "and>"

  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("TITLE_BLOCK")

  ' Build the selection set.
  '
  ssTitleBlock.Select Mode:=acSelectionSetAll, FilterType:=intData, FilterData:=varData

  ' Was anything actually found?
  '
  If ssTitleBlock.Count = 0 Then
    ' The title block wasn't found, notify the user and exit.
    '
    MsgBox "A Standard title block wasn't found, please correct and try again."
    End
  End If

  ' Collect the attributes.
  '
  varAttribs = AttribExtract(ssTitleBlock(0))

  ' Connect to the title block database.
  '
  Connect "H:\Room Datasheets\TBLOCK2DB\DrawingDatabase.mdb", strTblName

  ' Walk the array and find the "Primary Key" field.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    If UCase(varAttribs(intAttribCnt).TagString) = "FILENAME" Then
      ' Now search for the existence of this record in the database
      ' and if there's a match, ask the user how to handle it.
      '
      strSearch = varAttribs(intAttribCnt).TextString
      Exit For
    End If
  Next intAttribCnt

  ' Now search the database, duplicate drawing numbers aren't allowed,
  ' if one is found, prompt the user how handle it.
  '
  rstAttribs.Find "[FILENAME] = '" & strSearch & "'"

      ' For example using our database's primary key:
      '
      ' rstAttribs.Find "[FileName] = '" & strSearch & "'"

  If rstAttribs.EOF Then
    blnDuplicate = False  ' No existing record found.
  Else
    blnDuplicate = True   ' Existing record found.
  End If

  If blnDuplicate Then
    ' Ask the user how to handle the duplicate.
    '
    result = MsgBox("A record with " & strSearch & " already exists, overwrite existing data?", vbQuestion + vbYesNo)
    If result = vbNo Then
      'User doesn't want to overwrite data, just end the routine.
      '
      GoTo ExportAttribs_Exit
    End If
  End If

  If Not blnDuplicate Then
    ' Record doesn't exist, add it.
    '
    rstAttribs.AddNew
  End If

  ' Walk the array, comparing tag strings to field names,
  ' and populating or updating accordingly.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    For Each fldAttribs In rstAttribs.Fields
      ' Does the tag string value match the field name?
      '
      If UCase(fldAttribs.Name) = UCase(varAttribs(intAttribCnt).TagString) Then
        ' Must have the corresponding tag string and field name,
        ' make sure the attribute is not blank, then update the field.
        '
    If Len(fldAttribs.Value) > 0 Then
      fldAttribs.Value = varAttribs(intAttribCnt).TextString
    End If
        Exit For
      End If
    Next fldAttribs
  Next intAttribCnt

  ' Commit the changes.
  '
  rstAttribs.Update

ExportAttribs_Exit:

  ' Now close out the recordset and connections
  '
On Error Resume Next
  rstAttribs.Close
  cnnDataBse.Close

  Set rstAttribs = Nothing
  Set cnnDataBse = Nothing
  End

ExportAttribs_Error:
  MsgBox "Error: " & Err.Number & " - " & Err.Description
  Resume ExportAttribs_Exit

End Sub

Am I right in thinking that all my modifications will take place in 'Public Sub ExportAttribs()' after the line that reads 'varAttribs = AttribExtract(ssTitleBlock(0))'? All I want to do is import the fields of a specific record to the attributes of a block.

TCARPENTER (Programmer) · Answer 10 · 2007-08-08 08:30:06

Hi PZero,

You are correct about what module to modify.

Your plan, if I understand what you need to accomplish, should be:

Collect all the tab names in the drawing.
Collect all the blocks you need to update on each tab
Read the database and find any corresponding records, based on tab names.

if found - update the blocks.
if not found - add the information?

With this in mind, you may want to keep Export Attributes around to populate any missing data.

HTH
Todd

PZero (IS/IT--Management) · Answer 11 · 2007-08-08 09:16:03

Hi Todd, hope you are well today.

You are almost correct in what I want to achieve, of course my description becomes clearer the more I learn. All processes will be controlled from my access database, ie; a button press or other action. Command lines and scripts will then be passed to AutoCAD. So, for example;

User enters a new record into database in access.
User presses button marked 'Create datasheet'.
Button script opens a predefined drawing in AutoCAD, creates a new tab named after the primary key of the current record in access.
This VBA runs in AutoCAD performing the following;

Finds the name of the current tab (the tab just created).
Finds the record in the database with a primary key of the same name as the current tab.
Imports the fields of that record to enter into the attributes of the block on the current tab.

Export is not needed. All data will be stored in the database and the AutoCAD drawing will only be used for output. If a record is not in the database, it should not exist in the drawing, so maybe delete the tab from the drawing if the corresponding database record is not found?

I will also have a button somewhere in my database to update all the tabs in the drawing to match the records in the database, but I'll worry about that later since the basic functionality will become clear once I have this working.

PZero (IS/IT--Management) · Answer 12 · 2007-08-08 09:18:44

By the way, to make things a bit easier and because of the nature of the data I need to handle, the primary key will be Autonumber.

PZero (IS/IT--Management) · Answer 13 · 2007-08-08 12:14:48

Hi again,

I had a bit of a breakthrough and I have managed to get the script to import fields to the attributes, however, I am receiving a type mismatch error when trying to import from empty fields. How can I get around this and leave an attribute blank if the corresponding field has no data?

My code is as follows;

CODE

Public Sub ExportAttribs()

  Dim ssTitleBlock As AcadSelectionSet  'Selection set/title block to export.
  Dim intData()    As Integer           'DXF code for filtering.
  Dim varData()    As Variant           'DXF code description for filtering.
  Dim varAttribs   As Variant           'Attribute array from title block.
  Dim intAttribCnt As Integer           'Attribute array bounds.
  Dim fldAttribs   As ADODB.Field       'ADO fields from recordset.
  Dim strSearch    As String            'String to search for duplicates.
  Dim blnDuplicate As Boolean           'Duplicate record flag.
  Dim result       As VbMsgBoxResult    'User prompted responses.
  Dim strTblName   As String            'Name of Access table to populate.

  ' Defaults.
  '
  On Error GoTo ExportAttribs_Error
  strTblName = "tblDrawings"  ' Table name in database.
  Set AcadDoc = ThisDrawing   ' Current drawing.

  ' Build the filter criteria.
  '
  BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "TitleBlock", _
                                -4, "and>"

  ' Ensure a selection set is not already in memory.
  '
  Set ssTitleBlock = vbdPowerSet("TITLE_BLOCK")

  ' Build the selection set.
  '
  ssTitleBlock.Select Mode:=acSelectionSetAll, FilterType:=intData, FilterData:=varData

  ' Was anything actually found?
  '
  If ssTitleBlock.Count = 0 Then
    ' The title block wasn't found, notify the user and exit.
    '
    MsgBox "A Standard title block wasn't found, please correct and try again."
    End
  End If






  ' HERES WHERE I NEED TO FIND THE TAB NAME AND USE IT TO IDENTIFY WHICH RECORD TO IMPORT THE ATTRIBUTES FROM ******************

  ' Collect the attributes.
  '
  varAttribs = AttribExtract(ssTitleBlock(0))

  ' Connect to the title block database.
  '
  Connect "H:\Room Datasheets\TBLOCK2DB\DrawingDatabase.mdb", strTblName

  ' Walk the array and find the "Primary Key" field.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    If UCase(varAttribs(intAttribCnt).TagString) = "FILENAME" Then
      strSearch = varAttribs(intAttribCnt).TextString
      Exit For
    End If
  Next intAttribCnt





  ' HERES WHERE I CHECK TO SEE IF THE RECORD EXISTS ****************************************************************************

  ' Now search the database, duplicate drawing numbers aren't allowed,
  ' if one is found, prompt the user how handle it.
  '
  rstAttribs.Find "[FILENAME] = '" & strSearch & "'"

      ' For example using the database's primary key:
      '
      ' rstAttribs.Find "[FileName] = '" & strSearch & "'"

  If rstAttribs.EOF Then
    blnDuplicate = False  ' No existing record found.
  Else
    blnDuplicate = True   ' Existing record found.
  End If

  If Not blnDuplicate Then
    ' Record doesn't exist, inform user.
    '
    result = MsgBox("Record not found")
  End If




  ' HERES WHERE I NEED TO IMPORT FIELDS TO THE ATTRIBUTES **********************************************************************

  ' Walk the array, comparing tag strings to field names,
  ' and populating or updating accordingly.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    For Each fldAttribs In rstAttribs.Fields
      ' Does the tag string value match the field name?
      '
      If UCase(fldAttribs.Name) = UCase(varAttribs(intAttribCnt).TagString) Then
        ' Must have the corresponding tag string and field name,
        ' then update the field.
        '
      varAttribs(intAttribCnt).TextString = fldAttribs.Value
        Exit For
      End If
    Next fldAttribs
  Next intAttribCnt

  ' Commit the changes.
  '
  rstAttribs.Update




  ' EXIT THE DATABASE **********************************************************************************************************

ExportAttribs_Exit:

  ' Now close out the recordset and connections
  '
On Error Resume Next
  rstAttribs.Close
  cnnDataBse.Close

  Set rstAttribs = Nothing
  Set cnnDataBse = Nothing
  End

ExportAttribs_Error:
  MsgBox "Bollocks! Error " & Err.Number & " - " & Err.Description
  Resume ExportAttribs_Exit

End Sub

TCARPENTER (Programmer) · Answer 14 · 2007-08-08 13:28:42

Hi PZero,

Try something along the lines of:

CODE

If UCase(fldAttribs.Name) = UCase(varAttribs(intAttribCnt).TagString) And Not IsNull(fldAttribs.Value) Then
  ' Must have the corresponding tag string and field name,
  ' then update the field.
  '
  varAttribs(intAttribCnt).TextString = fldAttribs.Value
  Exit For
End If

HTH
Todd

PZero (IS/IT--Management) · Answer 15 · 2007-08-09 05:18:19

Good Morning,

Thanks for the code snippet Todd. It came in handy and I can now delete a field in a record in the database, and have the appropriate attribute blanked in AutoCAD. The code I now have is as follows;

CODE

  ' Walk the array, comparing tag strings to field names,
  ' and populating or updating accordingly.
  '
  For intAttribCnt = LBound(varAttribs) To UBound(varAttribs)
    For Each fldAttribs In rstAttribs.Fields
      ' Does the tag string value match the field name?
      '
      If UCase(fldAttribs.Name) = UCase(varAttribs(intAttribCnt).TagString) And Not IsNull(fldAttribs.Value) Then
  ' Must have the corresponding tag string and field name,
  ' then update the field.
  '
      fldFull = True
      Else
      fldFull = False
      End If

      If Not fldFull Then
      varAttribs(intAttribCnt).TextString = ""
      Else
      varAttribs(intAttribCnt).TextString = fldAttribs.Value

    Exit For
  End If

    Next fldAttribs
  Next intAttribCnt

  ' Commit the changes.
  '
  rstAttribs.Update

My drawing will have multiple layouts. I now need to add to the script so it will do the following;

determine the name of the current layout.
find the corresponding record in the database (layout name will also be primary key).
update the block on that layout from the record in the database.

I have found the following script which I may be able to use as the basis of a new subroutine;

CODE

Sub ad_LayoutIsolate()
  Dim fType(0 To 1) As Integer, fData(0 To 1)
  Dim DataSS As AcadSelectionSet
  Dim dwgEnt As AcadEntity
  Dim adLayout As AcadLayout
  Dim itemType As String
  Dim itemCount As Integer

  On Error Resume Next
'first create a selection set of all items of the type you want to work with
  Set DataSS = ThisDrawing.SelectionSets("DataSS")
  If Err Then Set DataSS = ThisDrawing.SelectionSets.Add("DataSS")
  DataSS.Clear
  itemType = "TEXT"  'this holds the type of entity we'll be collecting
  fType(0) = 0: fData(0) = itemType
  fType(1) = 8: fData(1) = "*"     'Here you specify the layer. We'll use all layers
  DataSS.Select acSelectionSetAll, , , fType, fData

'now we cycle through all the layouts
  For Each adLayout In ThisDrawing.Layouts
    itemCount = 0
    ThisDrawing.ActiveLayout = adLayout
    For Each dwgEnt In DataSS
'this is where the items residing on the current layout are culled
      If LCase(ThisDrawing.ObjectIdToObject(dwgEnt.OwnerID).Layout.Name) = LCase(adLayout.Name) Then
        itemCount = itemCount + 1
      End If
    Next dwgEnt
    MsgBox "Report for " & itemType & " Entities-" & vbCrLf & _
           "Total in the active drawing: " & DataSS.Count & vbCrLf & _
           "Total on layout " & adLayout.Name & ": " & itemCount
  Next adLayout
  DataSS.Delete
End Sub

Am I barking up the wrong tree? Is is a simple case of appending references to the block with 'ThisDrawing.ActiveLayout'?

TCARPENTER (Programmer) · Answer 16 · 2007-08-09 08:39:13

Hi PZero,

Quote:

1. determine the name of the current layout.

This line should do it:

CODE

strLayoutName = Thisdrawing.Activelayout.Name

Quote:

2. find the corresponding record in the database (layout name will also be primary key).

Just add the active layout name to your search criteria:

CODE

  ' HERES WHERE I CHECK TO SEE IF THE RECORD EXISTS ****************************************************************************

  ' Now search the database, duplicate drawing numbers aren't allowed,
  ' if one is found, prompt the user how handle it.
  '
  rstAttribs.Find "[FILENAME] = '" & strSearch & "' AND [LAYOUT] = '" & strLayoutName & "'"

      ' For example using the database's primary key:
      '
      ' rstAttribs.Find "[FileName] = '" & strSearch & "'"

  If rstAttribs.EOF Then
    blnDuplicate = False  ' No existing record found.
  Else
    blnDuplicate = True   ' Existing record found.
  End If

  If Not blnDuplicate Then
    ' Record doesn't exist, inform user.
    '
    result = MsgBox("Record not found")
  End If

Quote:

3. update the block on that layout from the record in the database.

You've already got that part. So, yes the code you posted could easily be modified to do what you want. Looks like you're on your way!

HTH
Todd

PZero (IS/IT--Management) · Answer 17 · 2007-08-09 09:08:31

Todd,

Thank you very much for all the help you are giving me.

I have now made the following changes;

CODE

  On Error GoTo ExportAttribs_Error
  strTblName = "tblDrawings"                        ' Table name in database.
  strLayoutName = ThisDrawing.ActiveLayout.Name     ' Current layout name
  Set AcadDoc = ThisDrawing                         ' Current drawing.

CODE

rstAttribs.Find "[FILENAME] = '" & strLayoutName & "'"

So the script is now using the record with the primary key that matches the layout name, which is correct. However, when it imports the fields from the database, it will only update the block that resides on the first layout. So if I go to 'layout002' and run the script, it imports the correct record, but updates the block on 'layout001' instead. How do I update the block on the current layout?

TCARPENTER (Programmer) · Answer 18 · 2007-08-09 09:36:38

Hi PZero,

It sounds like you still have a selection set in memory. You'll need to make your layout current and then select your blocks, or modify the selection set filter codes to select only blocks residing on a particular layout.

HTH
Todd

PZero (IS/IT--Management) · Answer 19 · 2007-08-09 10:06:47

The layout I want to update is current before I run the script, but it still imports the record into the block on the first layout, so if I understand correctly, it can't be a problem with an existing selection set still being in memory.

So I must have to modify the selection set filter codes to select only blocks residing on the current layout. I have no idea where to start :(

A quick google didn't seem very helpful either.

PZero (IS/IT--Management) · Answer 20 · 2007-08-10 04:30:59

It seems that code 410 for layouts does not work in VBA. I have posted another thread http://www.tek-tips.com/viewthread.cfm?qid=1397234&page=1 to see if I can find a solution.

TCARPENTER (Programmer) · Answer 21 · 2007-08-10 08:52:00

Hi PZero,

After a little experimenting - you are right the 410 code doesn't work. However, in your case since you have a paperspace tab active already, this will work:

CODE

BuildFilter intData, varData, -4, "<and", _
                                  0, "INSERT", _
                                  2, "TitleBlock", _
                                  67, 0, _
                                -4, "and>"

Just remember, it will only select the blocks named "TitleBlock" in paperspace on the ACTIVE LAYOUT only - it won't work in batch mode per se. If you need that, you'll need to walk the collection of tabs, set each one current, and then run the selection set.

HTH
Todd

PZero (IS/IT--Management) · Answer 22 · 2007-08-10 09:17:38

Thanks Todd, but it doesn't work. If set to 0 it won't select anything (nothing in model space), and if set to 1 it still selects the block on the first layout rather than the current layout.

After looking around I think whats needed is a routine of some sort to filter the selection set. Something like;

Send selection set to array
Purge blocks not on the current layout from the array
Import attributes to the remaining block in the array

Would something like that work?

PZero (IS/IT--Management) · Answer 23 · 2007-08-10 09:28:14

I posted on another forum and this was one of the replies;

CODE

Dim Id As Long
Dim b As AcadBlockReference
Id = ThisDrawing.PaperSpace.ObjectID
For Each b In ssTitleBlock
Debug.Print b.OwnerID
If b.OwnerID = Id Then
yadayada

Is that workable?

TCARPENTER (Programmer) · Answer 24 · 2007-08-10 09:47:52

Hi PZero,

You are correct it won't select anything in modelspace with a code 67 . 0 - your first layout is usually model space. I tried the response you received from another forum before I posted the above code and the OwnerID returned for block references (inserted blocks) is the block table record. So, no, it's not workable.

You may need to have some user interaction, or if your intial selection set count is zero, change the filter criteria and re-run the selection set again.

HTH
Todd

TCARPENTER (Programmer) · Answer 25 · 2007-08-10 09:51:49

RE: AtoCAD, Access and VBA

TCARPENTER (Programmer) 10 Aug 07 09:51

Kris,

Where did you go??

Todd

PZero (IS/IT--Management) · Answer 26 · 2007-08-10 10:23:25

Does it help that I know that there will be only one block on each layout that we are trying to update? So there will be several layouts, 001, 002, 03, etv, but each layout will have one block called for example, 'TitleBlock'. Is there no way of identifying that? For example 'ThisDrawing.ActiveLayout.Block("TitleBlock")' and the update the attributes of that block?

TCARPENTER (Programmer) · Answer 27 · 2007-08-10 11:30:59

Hi PZero,

Currently (at least up 2007) there is not. You would need to use uniquely named blocks. There may be a way in 2008.

HTH
Todd

PZero (IS/IT--Management) · Answer 28 · 2007-08-10 11:33:44

What about removing blocks from the selectionset that aren't on the current layout? Is that a possibility?

PZero (IS/IT--Management) · Answer 29 · 2007-08-15 08:56:21

Thanks for all your help Todd.

I gave on on layout filtering in the end and instead decided to create a new layer named the same as the layout on which the block resides to filter by. A bit messier than I wanted but it does the job.

Chris.

TCARPENTER (Programmer) · Answer 30 · 2007-08-15 10:41:04

Hi PZero,

Glad you could make it work!

Todd

Contact US

Come Join Us!

Posting Guidelines

AtoCAD, Access and VBA 2

AtoCAD, Access and VBA

AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

CODE

CODE

RE: AtoCAD, Access and VBA

Quote:

CODE

Quote:

CODE

Quote:

RE: AtoCAD, Access and VBA

CODE

CODE

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

CODE

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

RE: AtoCAD, Access and VBA

Red Flag This Post

Red Flag Submitted

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Join Tek-Tips® Today!

AtoCAD, Access and VBA
2

Join Tek-Tips^® Today!