替代标注文字trou

nacila · 发表于 2022-7-6 11:57:58

大家好，
在打开一个新的图形文件和许多不同类型的型腔图形时，我有自己的模板，我使用插入块命令插入这些图形。然后在标注这些空腔尺寸时使用“分解”命令。选定圆的直径测量随圆尺寸标注自动提供。但在那之后，我必须添加或附加一些额外的文本到特定于该空洞的维度。我不想每次都使用编辑文本命令。
所以我决定用VBA编写一个宏。我想做的是：
首先，我将选择用于标注尺寸的圆。选择后，将出现我的对话框，然后我将使用选项按钮选择型腔的类型。最后，当我单击命令按钮时，该空腔的特定文本将根据其直径自动涂改。我已经创建了对话框。
我的问题是，我熟悉VB，但我完全不懂VBA对象类型，我没有设法识别选定的圆。我试图创建一个新的AcadDimDiametric并使用AcadEntity指定选定的圆，但我不知道如何继续。
是否有任何信息资源或示例代码页可供探索？谢谢。。。

fixo · 发表于 2022-7-6 12:09:29

copy


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

我无法像使用ampowerdim_dia命令那样固定尺寸的位置。在使用ampowerdim\u dia完成标注后，是否有方法以编程方式编辑标注文本？我们如何理解某些用户使用ampowerdim\u dia命令完成了操作？非常感谢，新年快乐。。。

nacila · 发表于 2022-7-6 12:21:51

对不起，我对ampowerdim\u dia命令一无所知
我猜这不是一个普通的Autocad命令，不是吗？

试试这个，但稍微编辑一下

copy


   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

新年快乐

~'J'~

fixo · 发表于 2022-7-6 12:37:27

nacila · 发表于 2022-7-6 12:48:48

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 :

copy

   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 · 发表于 2022-7-6 12:58:11

Sorry I know nothing about ampowerdim_dia command
Guess it's not a plain Autocad command, isn't it?

Try this but slightly edited

copy

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

[编程交流] 替代标注文字trou

发表回复

精选推荐