请教高手，vba怎样赋属性
我需要将界址点的点号赋到界址点的属性或扩展属性里，在插入块时能实现赋属性吗？我是新手，用vba能实现插块和注记文字，但不会赋属性值，请高手教教我！
Private Sub CommandButton1_Click()
Dim JPD As Integer
Dim JX As String
Dim QSDH As Integer
Dim ZJDH As String
Dim zqdm As String
prompt1 = vbCrLf & "请选择界址点注记位置: "
startpnt = ThisDrawing.Utility.GetPoint(, prompt1)
x1 = startpnt(0)
y1 = startpnt(1)
jZD(0) = x1
jZD(1) = y1
jZDZJ(0) = x1 + 9
jZDZJ(1) = y1 - 7.5
ZJDH="zj2"
'插界址点块
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(jZD, "JZD.dwg", 1, 1, 1, 0)
'如果没有块
If Err Then
MsgBox Err
Exit Sub
Else
'怎样在这里实现将界址点号赋到扩展属性里？？？？
End If
'定义扩展属性
Private Sub CommandButton1_Click()
Dim JPD As Integer
Dim JX As String
Dim QSDH As Integer
Dim ZJDH As String
Dim zqdm As String
prompt1 = vbCrLf & "请选择界址点注记位置: "
startpnt = ThisDrawing.Utility.GetPoint(, prompt1)
x1 = startpnt(0)
y1 = startpnt(1)
jZD(0) = x1
jZD(1) = y1
jZDZJ(0) = x1 + 9
jZDZJ(1) = y1 - 7.5
ZJDH="zj2"
'插界址点块
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(jZD, "JZD.dwg", 1, 1, 1, 0)
'如果没有块
If Err Then
MsgBox Err
Exit Sub
End If
'定义扩展属性
'怎样在这里赋点号给块，在扩展属性里最好
'定义文字样式
Dim TextColl As AcadTextStyles
Dim textStyle As AcadTextStyle
Set textStyle = ThisDrawing.TextStyles.Add("JZDHT")
textStyle.fontFile = "C:\WINDOWS\Fonts\SIMHEI.TTF"
textStyle.Width = 17
textStyle.Height = 17
Set tmlay = ThisDrawing.Layers.Add("JZP")
tmlay.color = acRed
ThisDrawing.ActiveLayer = tmlay
Set textobj = ThisDrawing.ModelSpace.AddText(ZJDH, jZDZJ, 17)
textobj.ScaleFactor = 1
textobj.Update
textobj.Alignment = acAlignmentBottomLeft
' textobj.Alignment = acAlignmentMiddle
textobj.TextAlignmentPoint = jZDZJ
textobj.StyleName = "JZDHT"
End Sub
没人 Dim atr As Variant
atr = blockRefObj.GetAttributes
atr(0).TextString = 点号
页:
[1]