用.net开发cad时关于文字样式的问题
本帖最后由 风雪共舞 于 2011-10-23 17:32 编辑本人编写了下面的代码,运行程序后在cad命令窗口输入abc回车后,首先创建一个层设为当前层,然后创建一个文字样式设为当前样式,再创建文字,但是 运行后文字的字体变过来了,可是文字的倾斜角和文字的宽度比例没有按照预先设置的15度和0.7出现,现在把代码粘上来,望诸位大侠给看看咋回事:
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows
Imports System.IO
Public Class xuboClass
'以读写方式打开块表记录
Public Shared Function Appendentity(ByVal ent As Entity) As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim entid As ObjectId
Using trans As Transaction = db.TransactionManager.StartTransaction
'以读方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
'以写方式打开模型空间块表记录
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'将图形对象信息添加到块表记录中,并返回objectid对象
entid = btr.AppendEntity(ent)
'把图形对象添加到事物处理中
trans.AddNewlyCreatedDBObject(ent, True)
'提交事物
trans.Commit()
End Using
Return entid
End Function
Public Shared Function AddText(ByVal position As Point3d, ByVal textString As String, ByVal style As ObjectId, ByVal height As Double) As ObjectId
Try
' 在内存中创建单行文字对象.
Dim ent As New DBText()
' 设置文字插入点.
ent.Position = position
'设置文字内容.
ent.TextString = textString
' 设置文字样式.
ent.TextStyle = style
'设置文字高度.
ent.Height = height
'设置文字倾斜角.
ent.Oblique = oblique
' 设置文字旋转角度.
ent.Rotation = rotation
' 调用EntityToModelSpace函数,将单行文字加入到模型空间.
Dim entId As ObjectId = Appendentity(ent)
Return entId
Catch
' 创建失败,则返回一个空的ObjectId.
Dim nullId As ObjectId = ObjectId.Null
Return nullId
End Try
End Function
' Define command 'Asdkcmd1'
<CommandMethod("abc")> _
Public Sub start()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim layerId1 As ObjectId
Dim layerId2 As ObjectId
Using trans As Transaction = db.TransactionManager.StartTransaction()
' 以写方式打开层表.
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
' 声明一个用于图层的ObjectId.
' 如果不存在名为"abc"的图层,则新建一个图层.
If lt.Has("建筑物编号") = False Then
' 定义一个新的层表记录.
Dim ltr1 As New LayerTableRecord()
Dim ltr2 As New LayerTableRecord()
' 设置图层名.
ltr1.Name = "建筑物编号"
ltr2.Name = "编号圈"
' 通过颜色索引值的方式定义一个颜色.
Dim layerColor As Color = Color.FromColorIndex(ColorMethod.ByColor, 5)
' 设置图层颜色.
ltr1.Color = layerColor
ltr2.Color = layerColor
' 以读方式打开线型表.
Dim tt As LinetypeTable = trans.GetObject(db.LinetypeTableId, OpenMode.ForRead)
' 声明一个线型表记录.
Dim ttr As LinetypeTableRecord
Try
' 加载线型文件"acadiso.lin"中的"CENTER"线型.
db.LoadLineTypeFile("continuous", "acadiso.lin")
Catch
' 如果"CENTER"线型程序运行前已加载,则产生一个错误.
Exit Try
Finally
' 以读方式打开"CENTER"线型的线型表记录.
ttr = trans.GetObject(tt("continuous"), OpenMode.ForRead)
End Try
' 设置图层线型
ltr1.LinetypeObjectId = ttr.ObjectId
ltr2.LinetypeObjectId = ttr.ObjectId
' 设置图层线宽
ltr1.LineWeight = LineWeight.LineWeight000
ltr2.LineWeight = LineWeight.LineWeight000
' 显示线宽
db.LineWeightDisplay = True
' 线型比例
db.Ltscale = 1
' 图层锁定
'ltr.IsLocked = True
' 图层冻结
'ltr.IsFrozen = True
' 图层关闭
'ltr.IsOff = True
' 将层表记录的信息添加到层表中,并返回ObjectId对象.
layerId1 = lt.Add(ltr1)
layerId2 = lt.Add(ltr2)
' 把层表记录添加到事务处理中.
trans.AddNewlyCreatedDBObject(ltr1, True)
trans.AddNewlyCreatedDBObject(ltr2, True)
' 将图层“abc”设置当前层
db.Clayer = layerId1
End If
trans.Commit()
End Using
Dim db1 As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction
' 得到文字样式表
Dim st As TextStyleTable = trans.GetObject(db.TextStyleTableId, OpenMode.ForWrite)
Dim StyleName As String = "方正细等线简体"
' 如果名为"工程图"的文字样式不存在,则新建一个文字样式.
If st.Has(StyleName) = False Then
' 新建一个文字样式表记录.
Dim str As New TextStyleTableRecord()
' 设置文字样式名.
str.Name = StyleName
' 设置TrueType字体(仿宋体)
str.FileName = "方正细等线简体.ttf"
'---------------------------------------------
' 设置倾斜角(弧度).
str.ObliquingAngle = 15 * Math.PI / 180
' 设置宽度比例.
str.XScale = 0.7
' 把文字样式表记录添加到文字样式表中.
Dim TextstyleId As ObjectId = st.Add(str)
' 把文字样式表记录添加到事务处理中.
trans.AddNewlyCreatedDBObject(str, True)
' 将文字样式"工程图"设置为当前文字样式
db.Textstyle = TextstyleId
trans.Commit()
End If
End Using
Dim pot As New Point3d(0, 0, 0)
AddText(pot, "你好", db.Textstyle, 5)
End Sub
End Class
本问题自己已解决 如何读取autoCAD里面的字体样式? 通过 TextStyleTable和 TextStyleTableRecord 实现 帮帮忙啦楼主
页:
[1]