handent 模拟尺寸关联标注操作.

ningyong58

命令: dimreassociate
选择要重新关联的标注 ...
选择对象: (handent "180c")  (---- 操作成立 )
<图元名: 7ed77720>
找到 1 个

选择对象:

选择弧或圆<下一个>: (handent "180b") (------操作不成立)
<图元名: 7ed77718>

这关不过,无法编lisp程序.

问选择弧或圆,是否不能用HandEnt ,只能用鼠标来操作.谢谢.

英雄无敌

你可能还要用圆弧上的一点来组成一个表，就像用(entsel)得到的表一样

兰州人

选择弧或圆<下一个>: 这不是一个图元.
应选择为点(list 2 3 4)这也就是圆上的一点.
参考一个VBA程序

2. Sub LS()
3.   Dim Ent1 As AcadEntity, Ent2 As AcadEntity
4.   Dim objCircle As AcadCircle
5.   Dim objDia As AcadDimDiametric
6.   Dim DegToRad, ss As String
7.   DegToRad = Atn(1) * 4 / 180
8.   DD = 100
9.   With ThisDrawing
10.     Debug.Print tt
11.     Dim pp(2) As Double, pp1(2) As Double, pp2(2) As Double
12.     pp2(0) = 10 * Cos(45 * DegToRad) / 2
13.     pp2(1) = 10 * Sin(45 * DegToRad) / 2
14.     ss = "(LIST " & Str(DD / 2) & " 0  0)"
15.     ss = Left(ss, Len(ss) - 1) & ")"
16.     Set objCircle = .ModelSpace.AddCircle(pp, DD / 2)
17.     Set objDia = .ModelSpace.AddDimDiametric(pp, pp2, 10)
18.     tt = "(handent " & Chr(34) & objDia.Handle & Chr(34) & ")" & vbCr & vbCr
19.     tt = tt & ss & vbCr
20.     .SendCommand "Dimreassociate" & vbCr & tt
21.   End With
22. End Sub

Sub LS()   Dim Ent1 As AcadEntity, Ent2 As AcadEntity   Dim objCircle As AcadCircle   Dim objDia As AcadDimDiametric   Dim DegToRad, ss As String   DegToRad = Atn(1) * 4 / 180   DD = 100   With ThisDrawing     Debug.Print tt     Dim pp(2) As Double, pp1(2) As Double, pp2(2) As Double     pp2(0) = 10 * Cos(45 * DegToRad) / 2     pp2(1) = 10 * Sin(45 * DegToRad) / 2     ss = "(LIST " & Str(DD / 2) & " 0  0)"     ss = Left(ss, Len(ss) - 1) & ")"     Set objCircle = .ModelSpace.AddCircle(pp, DD / 2)     Set objDia = .ModelSpace.AddDimDiametric(pp, pp2, 10)     tt = "(handent " & Chr(34) & objDia.Handle & Chr(34) & ")" & vbCr & vbCr     tt = tt & ss & vbCr     .SendCommand "Dimreassociate" & vbCr & tt   End With End Sub

zml84

双元表。

(图元名  坐标)

兰州人

模拟Dimlinear和Diameter理解一下选择弧或圆或选择点的函义吧。

2. Sub LL()
3.   Dim objLine As AcadLine
4.   With ThisDrawing
5.     .SendCommand "E" & vbCr & "All" & vbCr & vbCr
6.     Dim DwgToRad
7.     DegToRad = Atn(1) * 4 / 180
8.     ''
9.     Dim objCircle As AcadCircle, Dd, Ss, Tt, Alfa
10.     Dd = 20
11.     Alfa = 40
12.     ''
13.     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, Pp(2) As Double
14.     P2(0) = 10
15.     P3(0) = 5: P3(1) = 5
16.     Pp(0) = Dd * Cos(Alfa * DegToRad) / 2
17.     Pp(1) = Dd * Sin(Alfa * DegToRad) / 2
18.     Set objLine = .ModelSpace.AddLine(P1, P2)
19.     Dim S1 As String, S2 As String, S3 As String
20.     S1 = "(list "
21.     S2 = "(list "
22.     S3 = "(list "
23.     Tt = "(list "
24.     For ii = 0 To 2
25.       S1 = S1 & P1(ii) & " "
26.       S2 = S2 & P2(ii) & " "
27.       S3 = S3 & P3(ii) & " "
28.       Tt = Tt & Pp(ii) & " "
29.     Next ii
30.     S1 = S1 & ")": S2 = S2 & ")": S3 = S3 & ")": Tt = Tt & ")"
31.     Debug.Print Tt
32.     .SendCommand "Dimlinear" & vbCr & S1 & vbCr & S2 & vbCr & S3 & vbCr
33.     Set objCircle = .ModelSpace.AddCircle(P1, Dd / 2)
34.     Ss = "(List " & Dd / 2 & " 0 0)"
35.    
36.     Debug.Print Ss
37.     'Tt = "A" & vbCr & "20" & vbCr & Ss & vbCr
38.     'Tt = Ss & vbCr
39.     .SendCommand "DimDiameter" & vbCr & Ss & vbCr & Tt & vbCr
40.    
41.   End With
42.   ZoomExtents
43.   
44. End Sub

Sub LL()   Dim objLine As AcadLine   With ThisDrawing     .SendCommand "E" & vbCr & "All" & vbCr & vbCr     Dim DwgToRad     DegToRad = Atn(1) * 4 / 180     ''     Dim objCircle As AcadCircle, Dd, Ss, Tt, Alfa     Dd = 20     Alfa = 40     ''     Dim P1(2) As Double, P2(2) As Double, P3(2) As Double, Pp(2) As Double     P2(0) = 10     P3(0) = 5: P3(1) = 5     Pp(0) = Dd * Cos(Alfa * DegToRad) / 2     Pp(1) = Dd * Sin(Alfa * DegToRad) / 2     Set objLine = .ModelSpace.AddLine(P1, P2)     Dim S1 As String, S2 As String, S3 As String     S1 = "(list "     S2 = "(list "     S3 = "(list "     Tt = "(list "     For ii = 0 To 2       S1 = S1 & P1(ii) & " "       S2 = S2 & P2(ii) & " "       S3 = S3 & P3(ii) & " "       Tt = Tt & Pp(ii) & " "     Next ii     S1 = S1 & ")": S2 = S2 & ")": S3 = S3 & ")": Tt = Tt & ")"     Debug.Print Tt     .SendCommand "Dimlinear" & vbCr & S1 & vbCr & S2 & vbCr & S3 & vbCr     Set objCircle = .ModelSpace.AddCircle(P1, Dd / 2)     Ss = "(List " & Dd / 2 & " 0 0)"         Debug.Print Ss     'Tt = "A" & vbCr & "20" & vbCr & Ss & vbCr     'Tt = Ss & vbCr     .SendCommand "DimDiameter" & vbCr & Ss & vbCr & Tt & vbCr       End With   ZoomExtents    End Sub