+ Reply to Thread
Results 1 to 6 of 6
  1. #1
    Senior Member TroutKing's Avatar
    Discipline
    Electrical
    TroutKing's Discipline Details
    Occupation
    I work as a designer and drafter for a mid sized multi-disciplined engineering firm
    Discipline
    Electrical
    Details
    I am the physical designer in the power/substation group of my company
    Using
    AutoCAD 2010
    Join Date
    May 2007
    Location
    Castle Rock Colorado
    Posts
    141

    Default VBA command for DIM HOME?

    Registered forum members do not see this ad.

    Hi everyone,

    Its been forever since I've been here - or even tried to create any macros and I'm super rusty. I have what I hope is a quick question.

    I've included a portion of my macro below. As you can see - I've even tried the dang sendcommand code. But still to no avail.

    Can someone help me in locating VBA code that will send dimension text back to itt' home location?


    Code:
     
        For Each EntityWithinMySelectionSet In MySelectionSet
            If TypeOf EntityWithinMySelectionSet Is AcadDimension Then
                EntityWithinMySelectionSet.Update
                ThisDrawing.SendCommand "dim" & vbCr & "HOME" & vbCr & "L" & vbCr & vbCr
                ThisDrawing.SendCommand Chr(27) & Chr(27) & Chr(27)
            End If
        Next
    Thank you, I appreciate your help.....

  2. #2
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Pietari, Venäjä
    Posts
    1,687

    Default

    You have to use HANDENT function to get the dimensions,
    see if this helps
    Code:
     
    Option Explicit
    Public Sub testdim()
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    Dim dxfcode, dxfdata
    Dim oEnt As AcadEntity
    Dim oDim As AcadDimension
    Dim setObj As AcadSelectionSet
    Dim setColl As AcadSelectionSets
    Dim setName As String
    Dim objEnt As AcadEntity
     
    On Error GoTo Err_Control
    gpCode(0) = 0: dataValue(0) = "DIMENSION"
    dxfcode = gpCode: dxfdata = dataValue
     
    setName = "$DIMENSION$"
    With ThisDrawing
    Set setColl = .SelectionSets
    For Each setObj In setColl
    If setObj.Name = setName Then
    .SelectionSets.Item(setName).Delete
    Exit For
    End If
    Next
    Set setObj = .SelectionSets.Add(setName)
    End With
     
    setObj.SelectOnScreen dxfcode, dxfdata
    setObj.Highlight True
    MsgBox "Selected: " & CStr(setObj.Count) & " objects"
    For Each oEnt In setObj
    Set oDim = oEnt
    If TypeOf oDim Is AcadDimension Then
    Dim hwdl As String
    hwdl = oDim.Handle
    ThisDrawing.SendCommand "dim" & vbCr & "HOME" & vbCr & "(handent " & Chr(34) & hwdl & Chr(34) & ")" & vbCr & vbCr
    ThisDrawing.SendCommand Chr(27) & Chr(27) & Chr(27)
    oDim.Update
    End If
    Next
    Err_Control:
    MsgBox Err.Number
    End Sub
    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  3. #3
    Senior Member TroutKing's Avatar
    Discipline
    Electrical
    TroutKing's Discipline Details
    Occupation
    I work as a designer and drafter for a mid sized multi-disciplined engineering firm
    Discipline
    Electrical
    Details
    I am the physical designer in the power/substation group of my company
    Using
    AutoCAD 2010
    Join Date
    May 2007
    Location
    Castle Rock Colorado
    Posts
    141

    Default

    Thank you Oleg! As always, your help is second to none

    So I've done my best to apply your solution to my code and have come up with two issues. One that I can bypass and one that I can't. Unfortunately this has left me short of reaching your "handent" solution so I can't even get around to understanding that yet.

    I have two questions below this abbreviated code:

    Code:
     
    Option Explicit
    Sub UpdateExistingDimensionStyles()
    'On Error GoTo Err_Control
    Dim MySelectionSet As AcadSelectionSet
    Dim MyCollectionSet As AcadSelectionSets
    Dim MyCollectionSetName As String
    MyCollectionSetName = "TheDimensionsToUpdate"
    Dim MyObject As AcadEntity
    Dim MyDimension As AcadDimension
    '-----------------------------------------------------------------------------------
    With ThisDrawing
        Set MyCollectionSet = ThisDrawing.SelectionSets
            For Each MySelectionSet In MyCollectionSet
                If MySelectionSet.Name = MyCollectionSetName Then
                    ThisDrawing.SelectionSets.Item(MyCollectionSetName).Delete
                    Exit For
                End If
            Next
        Set MySelectionSet = ThisDrawing.SelectionSets.Add(MyCollectionSetName)
    End With
    '-----------------------------------------------------------------------------------
    MySelectionSet.Select acSelectionSetAll
    For Each MyObject In MySelectionSet
        Set MyDimension = MyObject
        If TypeOf MyDimension Is AcadDimension Then
            Dim MyHandle As String
            MyHandle = MyDimension.Handle
            ThisDrawing.SendCommand "dim" & vbCr & "HOME" & vbCr & "L" & vbCr & vbCr & "(handent " & Chr(34) & MyHandle & Chr(34) & ")" & vbCr & vbCr
            ThisDrawing.SendCommand Chr(27) & Chr(27) & Chr(27)
            MyObject.Update
        End If
    Next
     
    MySelectionSet.Clear
    MySelectionSet.Delete
    '-----------------------------------------------------------------------------------
    Set MySelectionSet = Nothing
    Set MyDimension = Nothing
    ThisDrawing.PurgeAll
    ThisDrawing.PurgeAll
    ThisDrawing.PurgeAll
    Application.ZoomExtents
    'ThisDrawing.Save
    'Err_Control:
    'MsgBox Err.Number
    MsgBox ("             DONE")
    End Sub
    Question 1. At line "MySelectionSet.Select" I have to place "MySelectionSet.Select acSelectionSetAll. Why can't I get it to work using my specified collection name something like this "MySelectionSet.Select (MyCollectionSetName)"?

    Question 2. I'm getting a type-mismatch error at this line "Set MyDimension = MyObject". Grrr. Why?

    Can you point me in the right direction yet again?

  4. #4
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Pietari, Venäjä
    Posts
    1,687

    Default

    Hi Mike,
    Handent is Vanilla AutoLisp function this will allow you to get
    object by its handle (this one is stored in dxf code 5 in entity list),
    see edited code:

    Code:
     
    Option Explicit
    Sub UpdateExistingDimensionStyles()
    'On Error GoTo Err_Control
    Dim MySelectionSet As AcadSelectionSet
    Dim MyCollectionSet As AcadSelectionSets
    Dim MyCollectionSetName As String
    MyCollectionSetName = "TheDimensionsToUpdate"
    Dim MyObject As AcadEntity
    Dim MyDimension As AcadDimension
    Dim dxfcode(0) As Integer
    Dim dxfValue(0) As Variant
    '-----------------------------------------------------------------------------------
    With ThisDrawing
        Set MyCollectionSet = ThisDrawing.SelectionSets
            For Each MySelectionSet In MyCollectionSet
                If MySelectionSet.Name = MyCollectionSetName Then
                    .SelectionSets.Item(MyCollectionSetName).Delete
                    Exit For
                End If
            Next
        Set MySelectionSet = .SelectionSets.Add(MyCollectionSetName)
    End With
    '-----------------------------------------------------------------------------------
    dxfcode(0) = 0
    dxfValue(0) = "DIMENSION"
    Dim groupCode As Variant
    Dim dataCode As Variant
        groupCode = dxfcode
        dataCode = dxfValue
     Dim mode As Integer
     mode = acSelectionSetAll '<-- declared explicitly
    ''you can see the syntax of this method in the Help file:
    MySelectionSet.Select mode, , , groupCode, dataCode '<-- omitted the window selection points(as commas)
    For Each MyObject In MySelectionSet
        Set MyDimension = MyObject
        If TypeOf MyDimension Is AcadDimension Then
            Dim MyHandle As String
            MyHandle = MyDimension.Handle
            'removed extrafluous VbCr from the next line:
            ThisDrawing.SendCommand "dim" & vbCr & "HOME" & vbCr & "L" & vbCr & "(handent " & Chr(34) & MyHandle & Chr(34) & ")" & vbCr & vbCr
            ThisDrawing.SendCommand Chr(27) & Chr(27) & Chr(27)
            MyObject.Update
        End If
    Next
     'Optional for this code context, because of you deleted this selection set on the start of code:
    'MySelectionSet.Clear
    'MySelectionSet.Delete
    '-----------------------------------------------------------------------------------
    'Set MySelectionSet = Nothing
    'Set MyDimension = Nothing
    ThisDrawing.PurgeAll
    ThisDrawing.PurgeAll
    ThisDrawing.PurgeAll
    Application.ZoomExtents
    'ThisDrawing.Save
    'Err_Control:
    'MsgBox Err.Number
    MsgBox ("             POKEY")
    End Sub
    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

  5. #5
    Senior Member TroutKing's Avatar
    Discipline
    Electrical
    TroutKing's Discipline Details
    Occupation
    I work as a designer and drafter for a mid sized multi-disciplined engineering firm
    Discipline
    Electrical
    Details
    I am the physical designer in the power/substation group of my company
    Using
    AutoCAD 2010
    Join Date
    May 2007
    Location
    Castle Rock Colorado
    Posts
    141

    Default

    You are too awesome Oleg! I needed to make one minor adjustment and your solutions fit right into my final routine that I'm building. Thank you so much!!

  6. #6
    Super Member fixo's Avatar
    Computer Details
    fixo's Computer Details
    Operating System:
    Windows 7
    Motherboard:
    E7500
    CPU:
    Intel(R)Core(TM)2 DUO CPU 2.93HGz
    RAM:
    4098 Gb
    Graphics:
    1024 Gb
    Using
    AutoCAD 2009
    Join Date
    Jul 2005
    Location
    Pietari, Venäjä
    Posts
    1,687

    Default

    Registered forum members do not see this ad.

    Glad you have it working. Thanks for letting me know.
    See ya

    ~'J'~
    The soul is healed by being with children. - Fyodor Dostoyevsky, novelist (1821-1881)

Similar Threads

  1. New home PC on the way
    By f700es in forum Hardware & Operating Systems
    Replies: 15
    Last Post: 2nd Sep 2011, 07:03 pm
  2. New toy at home...
    By f700es in forum Hardware & Operating Systems
    Replies: 17
    Last Post: 26th Apr 2007, 01:43 pm
  3. Welcome to our new home
    By CADTutor in forum News, Announcements & FAQ
    Replies: 6
    Last Post: 22nd Sep 2006, 08:04 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts