替代标注文字trou
大家好，在打开一个新的图形文件和许多不同类型的型腔图形时，我有自己的模板，我使用插入块命令插入这些图形。然后在标注这些空腔尺寸时使用“分解”命令。选定圆的直径测量随圆尺寸标注自动提供。但在那之后，我必须添加或附加一些额外的文本到特定于该空洞的维度。我不想每次都使用编辑文本命令。
所以我决定用VBA编写一个宏。我想做的是：
首先，我将选择用于标注尺寸的圆。选择后，将出现我的对话框，然后我将使用选项按钮选择型腔的类型。最后，当我单击命令按钮时，该空腔的特定文本将根据其直径自动涂改。我已经创建了对话框。
我的问题是，我熟悉VB，但我完全不懂VBA对象类型，我没有设法识别选定的圆。我试图创建一个新的AcadDimDiametric并使用AcadEntity指定选定的圆，但我不知道如何继续。
是否有任何信息资源或示例代码页可供探索？谢谢。。。
...............
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命令完成了操作？非常感谢，新年快乐。。。
对不起，我对ampowerdim\u dia命令一无所知
我猜这不是一个普通的Autocad命令，不是吗？
试试这个，但稍微编辑一下
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'~ 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.Number0 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.Number0 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'~
页:
[1]