TroutKing Posted May 2, 2012 Share Posted May 2, 2012 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? 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..... Quote Link to comment Share on other sites More sharing options...
fixo Posted May 3, 2012 Share Posted May 3, 2012 You have to use HANDENT function to get the dimensions, see if this helps 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'~ Quote Link to comment Share on other sites More sharing options...
TroutKing Posted May 3, 2012 Author Share Posted May 3, 2012 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: 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? Quote Link to comment Share on other sites More sharing options...
fixo Posted May 3, 2012 Share Posted May 3, 2012 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: 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'~ Quote Link to comment Share on other sites More sharing options...
TroutKing Posted May 4, 2012 Author Share Posted May 4, 2012 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!! Quote Link to comment Share on other sites More sharing options...
fixo Posted May 4, 2012 Share Posted May 4, 2012 Glad you have it working. Thanks for letting me know. See ya ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.