谁来帮帮我？
我写了一段CASS展点程序，可是展上去的点没办法写上扩展属性，不能让CASS识别。我知道CASS在展点时写上了一个隐藏的“SOUTH”属性，值为202101，可是用VBA怎么样才能将这个属性写上去？我的原程序如下，请各位高手指点：Sub zgcd()<BR>Dim pn As Variant<BR>Dim pnt(0 To 2) As Double<BR>Dim blockRefObj As AcadBlockReference<BR>Dim textObj As AcadText<BR>Dim dh As String<BR>Dim x As Double<BR>Dim y As Double<BR>Dim z As Double<BR>Dim pcode As String<BR>Dim ly As AcadLayer<BR>UserForm4.Show<BR>Dim texth As Double
<BR>Set ly = ThisDrawing.Layers.Add("高程")<BR>ly.color = acGreen<BR>Set ly = ThisDrawing.Layers.Add("点号")<BR>ly.color = acMagenta<BR>Set ly = ThisDrawing.Layers.Add("GCD")<BR>ly.color = acRed<BR>UserForm1.CommonDialog1.Filter = "All Files|*.*|*.dat|*.dat|"<BR>UserForm1.CommonDialog1.FilterIndex = 2<BR>UserForm1.CommonDialog1.DefaultExt = ".dat"<BR>UserForm1.CommonDialog1.Action = 1<BR>fl1 = UserForm1.CommonDialog1.FileName<BR>If fl1 = "" Then Exit Sub<BR>Open fl1 For Input As #1<BR>Line Input #1, dh<BR>I = InStr(1, dh, ",")<BR>If I > 0 Then<BR>Close #1 <BR>Open fl1 For Input As #1<BR>End If<BR>I = 0<BR>Do While Not EOF(1)<BR>On Error GoTo ex1<BR>Input #1, dh, pcode, x, y, z<BR>pnt(0) = x<BR>pnt(1) = y<BR>pnt(2) = z<BR>If pnt(0) * pnt(1) * pnt(2) <> 0 Then<BR>Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(pnt, "GC200", 0.1, 0.1, 1#, 0)<BR>blockRefObj.Layer = "GCD"<BR>blockRefObj.color = acByLayer
'这里应该写点什么才能将点的SOUTH属性设成202101
Set textObj = ThisDrawing.ModelSpace.AddText(pnt(2), pnt, 0.2)<BR>textObj.Layer = "高程"<BR>textObj.color = acByLayer<BR><BR>pnt(0) = pnt(0) - Len(dh) * 0.2<BR>Set textObj = ThisDrawing.ModelSpace.AddText(dh, pnt, 0.2)<BR>textObj.Layer = "点号"<BR>textObj.color = acByLayer<BR><BR>I = I + 1<BR>End If<BR>Loop<BR>ThisDrawing.Utility.prompt ("共展高程点：" & Str(I) & "个" & Chr$(13) + Chr$(10))<BR>Close #1<BR>ex1:<BR>ThisDrawing.Application.ZoomExtents<BR>End Sub<BR>
页:
[1]