|
|
发表于 2006-6-1 15:43:00
|
显示全部楼层
感谢xinghesnak回复，字体问题我在CAD2006版上未发现。这个问题我自己也刚刚用选择集解决，现拿出来与大家一起讨论。
Private Sub AcadDocument_Activate()
Dim TextObj As AcadText
Dim TextString As String
Dim InsPnt(0 To 2) As Double
Dim Height As Double
Set FontStyle = ThisDrawing.TextStyles.Add("宋体长型0.67")
FontStyle.SetFont "宋体", False, False, 0, 0
If Not Err Then ThisDrawing.ActiveTextStyle = FontStyle
FontStyle.Height = 6
FontStyle.Width = 0.4
ThisDrawing.ActiveTextStyle = FontStyle
InsPnt(0) = 259: InsPnt(1) = 1.8: InsPnt(2) = 0
Height = 6.5
s = Format(ConvertJulianDate(ThisDrawing.GetVariable("DATE")), "YYYY.MM.DD")
TextString = s
Set TextObj = ThisDrawing.ModelSpace.AddText(TextString, InsPnt, Height)
End Sub
Private Sub AcadDocument_Deactivate()
Dim SSetObj As AcadSelectionSet
Set SSetObj = ThisDrawing.SelectionSets.Add("DelDateText")
'创建过滤器Text(单行文本)、Mtext(多行文本)
Dim fType(0) As Integer
Dim fData(0) As Variant
fType(0) = 0
fData(0) = "Text,Mtext"
'选择全部的Text、Mtext
SSetObj.Select acSelectionSetAll, , , fType, fData
If SSetObj.Count 0 Then
Dim i As Integer
For i = 0 To SSetObj.Count - 1
'Text和Mtext中显示的是TextString
If SSetObj(i).TextString =[B] s Then SSetObj(i).Delete
Next
End If
SSetObj.Delete
Set SSetObj = Nothing
End Sub
'以下加载在模块内：
Public s As String '申明S(存放当前日期)全局字符变量,这点很重要。两过程共用此变量！
Public Function ConvertJulianDate(julianDate As Double) As Date
ConvertJulianDate = julianDate - 2415019
End Function
感谢乐筑天下！感谢晓东CAD！ 黄玉宏 2006.6.1
|
|
置顶卡
