Jump to content

VBA command for DIM HOME?


TroutKing

Recommended Posts

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

Link to comment
Share on other sites

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'~

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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'~

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...