lennie 发表于 2006-4-19 16:44:00

固定标注值并改变标注颜色出现的新问题

<P>Private Sub CommandButton1_Click()</P>
<P>On Error GoTo Err_handle<BR>&nbsp;&nbsp;&nbsp; Dim FilterType(0) As Integer<BR>&nbsp;&nbsp;&nbsp; Dim FilterData(0) As Variant<BR>&nbsp;&nbsp;&nbsp; Dim point As Variant<BR>&nbsp;&nbsp;&nbsp; Me.Hide<BR>&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Set SSdim = ThisDrawing.SelectionSets.Add("S_t_dim")<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; FilterType(0) = 0<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; FilterData(0) = "DIMENSION"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SSdim.SelectOnScreen FilterType, FilterData<BR>&nbsp;&nbsp;&nbsp; If SSdim.Count = 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "你没有选择标注，程序中止！", vbOKOnly<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("S_t_dim").Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; Dim EntityInBlock As AcadEntity<BR>&nbsp;&nbsp;&nbsp; Dim TextString As String<BR>&nbsp;&nbsp;&nbsp; Dim Sobj As AcadObject<BR>&nbsp;&nbsp;&nbsp; Dim BlkId As Double<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; For Each Sobj In SSdim<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; BlkId = Sobj.OwnerID<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; TextString = "123"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each EntityInBlock In ThisDrawing.ObjectIdToObject(BlkId)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If EntityInBlock.ObjectName = "AcDbMText" Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; TextString = EntityInBlock.TextString<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sobj.TextOverride = TextString<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sobj.TextColor = acYellow<BR>&nbsp;&nbsp;&nbsp; Next<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("S_t_dim").Delete<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Exit Sub<BR>Err_handle:<BR>&nbsp;&nbsp;&nbsp; If Err.Number = -2145320851 Then&nbsp;&nbsp; '已经存在“S_t_dim”选集<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("S_t_dim").Delete<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; CommandButton1_Click<BR>&nbsp;&nbsp;&nbsp; End If</P>
<P>End Sub</P>
页: [1]
查看完整版本: 固定标注值并改变标注颜色出现的新问题