Overriding Dimension Text trouble in VBA

[nacila]

Hi everyone ,

I have my own template while opening a new drawing file and many different type of cavity drawings which I insert with Insert Block command.Then I use Explode command while dimensioning these cavities.The measure of diameters of the selected circles comes automatically with circular dimensioning.But after that , I have to add or append some additional text to that dimension specific to that cavity.I don't want to use Edit Text command each time.

So I have decided to write a macro in VBA.What I am trying to do is as follows :

First I will select the circle for dimensioning.After selecting that my dialog box will appear and then I will select the type of the cavity with option buttons.Finally when I click a command button , the specific text for that cavity will be wrotten automatically according to its diameter.I have created my dialog box.

My problem is that I'm familiar with VB but I am completely lost in VBA object types and I did not manage to identify the selected circle.I tried to create a new AcadDimDiametric and to use AcadEntity to specify the selected circle but I don't know how to continue.

Is there any information resource or sample code pages to explore on this subject ? Thanks a lot...

[fixo]

Hi everyone ,

I have my own template while opening a new drawing file and many different type of cavity drawings which I insert with Insert Block command.Then I use Explode command while dimensioning these cavities.The measure of diameters of the selected circles comes automatically with circular dimensioning.But after that , I have to add or append some additional text to that dimension specific to that cavity.I don't want to use Edit Text command each time.

So I have decided to write a macro in VBA.What I am trying to do is as follows :

First I will select the circle for dimensioning.After selecting that my dialog box will appear and then I will select the type of the cavity with option buttons.Finally when I click a command button , the specific text for that cavity will be wrotten automatically according to its diameter.I have created my dialog box.

My problem is that I'm familiar with VB but I am completely lost in VBA object types and I did not manage to identify the selected circle.I tried to create a new AcadDimDiametric and to use AcadEntity to specify the selected circle but I don't know how to continue.

Is there any information resource or sample code pages to explore on this subject ? Thanks a lot...

...............
Dim oDimDia as AcadDimDiametric
Dim oEnt as AcadEntity
Dim oCircle as AcadCircle
'After you selected a circle try this
If TypeOf oent Is AcadCircle Then
Set oCircle =oEnt
oDimDia.TextOveride = "Diameter=" & Cstr(oDimDia.Measurement)' <--or something you need
End If

 

~'J'~

[nacila]

...............
Dim oDimDia as AcadDimDiametric
Dim oEnt as AcadEntity
Dim oCircle as AcadCircle
'After you selected a circle try this
If TypeOf oent Is AcadCircle Then
Set oCircle =oEnt
oDimDia.TextOveride = "Diameter=" & Cstr(oDimDia.Measurement)' <--or something you need
End If

 

~'J'~

 

Hello fixo ,

 

Thanks for that code example.I tried that code exactly as you wrote.But now this code generates an error while entering in If block which says :

 

Object variable or With block variable not set

 

I have set the dialog box to Modeless to be able to choose a circle before clicking the command button.And so when I run the macro first the dialog box appears then I choose a circle finally I click the command button and my code generates the error above.What is wrong with that ? Am I logically wrong ? I am open to any suggestions.Thanks very much...

[fixo]

Hello fixo ,

 

Thanks for that code example.I tried that code exactly as you wrote.But now this code generates an error while entering in If block which says :

 

Object variable or With block variable not set

 

I have set the dialog box to Modeless to be able to choose a circle before clicking the command button.And so when I run the macro first the dialog box appears then I choose a circle finally I click the command button and my code generates the error above.What is wrong with that ? Am I logically wrong ? I am open to any suggestions.Thanks very much...

 

Sorry if I've misunderstood something

Please, show your code here

 

~'J'~

[fixo]

Hello fixo ,

 

Thanks for that code example.I tried that code exactly as you wrote.But now this code generates an error while entering in If block which says :

 

Object variable or With block variable not set

 

QUOTE]

 

Here is a complete example

Hope it will helps:

 

Sub SelDimAtPoint()

   Dim oSset As AcadSelectionSet
   Dim oEnt As AcadEntity
   Dim oCircle As AcadCircle
   Dim oPline As AcadLWPolyline
   Dim oUtil As AcadUtility
   Dim fCode(0) As Integer
   Dim fdata(0) As Variant
   Dim oDim As AcadDimDiametric
   Dim dxfCode As Variant
   Dim dxfData As Variant
   Dim ptVar As Variant


   fCode(0) = 0
   fdata(0) = "DIMENSION"

   dxfCode = fCode
   dxfData = fdata

   On Error GoTo Err_Control
   Set oUtil = ThisDrawing.Utility

   oUtil.GetEntity oEnt, ptVar, vbLf & "Select circle"

   If TypeOf oEnt Is AcadCircle Then
       Set oCircle = oEnt
       ptVar = oCircle.Center

       With ThisDrawing.SelectionSets
           While .Count > 0
               .Item(0).Delete
           Wend
       End With

       Set oSset = ThisDrawing.SelectionSets.Add("$SelAtPoint$")

       oSset.SelectAtPoint ptVar, dxfCode, dxfData

       If oSset.Count = 0 Then
           MsgBox "Nothing selected, try again"
           Exit Sub
       End If
       If oSset.Count > 1 Then
           MsgBox "Selected more than one objects. Program stopped"
           Exit Sub
       Else
           'MsgBox "Selected: " & oSset.Count & " objects"
           Set oEnt = oSset.Item(0)
           If TypeOf oEnt Is AcadDimDiametric Then
               Set oDim = oEnt
               Debug.Print oDim.Measurement    'debug only
               oDim.TextOverride = "Diameter=" & CStr(oDim.Measurement)
               Debug.Print oDim.TextOverride    'debug only
           End If
       End If
   End If

Exit_Here:

   oSset.Delete
   Exit Sub

Err_Control:
   If Err.Number <> 0 Then
       MsgBox Err.Description
   End If
   Resume Exit_Here

End Sub

 

~'J'~

[nacila]

Hello everyone ;

 

So far , I have managed to add diametric dimension and I know how to update the dimension text.But now I have point setting problems on the added dimension.Here is what I have wrote :

 

   Private Sub AddDimensionText()
     Dim dimDiametric As AcadDimDiametric
     Dim util As AcadUtility
     Dim entity As AcadEntity
     Dim circ As AcadCircle
     Dim centerPoint As Variant
     Dim pt1(0 To 2) As Double
     Dim pt2(0 To 2) As Double
     Dim dimLength As Double
     Dim mainLength As Double

     On Error Resume Next
     Set util = ThisDrawing.Utility
     util.GetEntity entity, centerPoint, "Select circle"
     If Err.Number <> 0 Then
         Err.Clear
         MsgBox "Entity not selected"
     Else
         If TypeOf entity Is AcadCircle Then
             Set circ = entity
             centerPoint = circ.Center 
             dimLength = circ.Radius 
             mainLength = Math.Sqr((dimLength * dimLength) + (dimLength * dimLength)) 
             pt1(0) = centerPoint(0) + dimLength: pt1(1) = centerPoint  (1) + dimLength: pt1(2) = 0 
             pt2(0) = pt1(0) + mainLength: pt2(1) = pt1(1) + mainLength: pt2(2) = 0
             Set dimDiametric =   ThisDrawing.ModelSpace.AddDimDiametric(pt2, pt1, 0)
             dimDiametric.Update
         Else
             MsgBox "Please select a circle"
         End If
     End If
 End Sub

 

I could not fix the position of the dimension as we can do with ampowerdim_dia command.Is there a way to edit programmatically the dimension text after finishing the dimensioning using ampowerdim_dia ? How can we understand that some user is finished using ampowerdim_dia command ? Thanks a lot , happy new year...

[fixo]

Hello everyone ;

 

So far , I have managed to add diametric dimension and I know how to update the dimension text.But now I have point setting problems on the added dimension.Here is what I have wrote :

 

   Private Sub AddDimensionText()
     Dim dimDiametric As AcadDimDiametric
     Dim util As AcadUtility
     Dim entity As AcadEntity
     Dim circ As AcadCircle
     Dim centerPoint As Variant
     Dim pt1(0 To 2) As Double
     Dim pt2(0 To 2) As Double
     Dim dimLength As Double
     Dim mainLength As Double

     On Error Resume Next
     Set util = ThisDrawing.Utility
     util.GetEntity entity, centerPoint, "Select circle"
     If Err.Number <> 0 Then
         Err.Clear
         MsgBox "Entity not selected"
     Else
         If TypeOf entity Is AcadCircle Then
             Set circ = entity
             centerPoint = circ.Center 
             dimLength = circ.Radius 
             mainLength = Math.Sqr((dimLength * dimLength) + (dimLength * dimLength)) 
             pt1(0) = centerPoint(0) + dimLength: pt1(1) = centerPoint  (1) + dimLength: pt1(2) = 0 
             pt2(0) = pt1(0) + mainLength: pt2(1) = pt1(1) + mainLength: pt2(2) = 0
             Set dimDiametric =   ThisDrawing.ModelSpace.AddDimDiametric(pt2, pt1, 0)
             dimDiametric.Update
         Else
             MsgBox "Please select a circle"
         End If
     End If
 End Sub

 

I could not fix the position of the dimension as we can do with ampowerdim_dia command.Is there a way to edit programmatically the dimension text after finishing the dimensioning using ampowerdim_dia ? How can we understand that some user is finished using ampowerdim_dia command ? Thanks a lot , happy new year...

 

Sorry I know nothing about ampowerdim_dia command

Guess it's not a plain Autocad command, isn't it?

 

Try this but slightly edited

 

 
Option Explicit
   Private Sub AddDimensionText()
     Dim dimDiametric As AcadDimDiametric
     Dim util As AcadUtility
     Dim entity As AcadEntity
     Dim circ As AcadCircle
     Dim centerPoint As Variant
     Dim pt1(0 To 2) As Double
     Dim pt2(0 To 2) As Double
     Dim pi As Double
     pi = 3.14159265358979
     Dim dimLength As Double
     Dim mainLength As Double

     On Error Resume Next
     Set util = ThisDrawing.Utility
     util.GetEntity entity, centerPoint, "Select circle"
     If Err.Number <> 0 Then
         Err.Clear
         MsgBox "Entity not selected"
     Else
         If TypeOf entity Is AcadCircle Then
             Set circ = entity
             centerPoint = circ.Center
             dimLength = circ.Radius
             mainLength = dimLength * Sin(pi / 4)
              pt1(0) = centerPoint(0) - mainLength: pt1(1) = centerPoint(1) - mainLength: pt1(2) = 0
              pt2(0) = centerPoint(0) + mainLength: pt2(1) = centerPoint(1) + mainLength: pt2(2) = 0

             Set dimDiametric = ThisDrawing.ModelSpace.AddDimDiametric(pt2, pt1, dimLength)
             dimDiametric.LeaderLength = dimLength
             dimDiametric.Update
         Else
             MsgBox "Please select a circle"
         End If
     End If
 End Sub

 

Happy New Year

 

~'J'~