请问怎样将一行文字在指定位置写入CAD

heimj

请问怎样将一行文字在指定位置写入CAD，要求使用某图层，并且控制文字的大小、颜色？

请用vb写代码，谢谢！！！

weianhui

需要将CAD的类型库包含进来，定义CAD类的对象，然后定义一个ACADDOCUMENT对象，然后就像操作AutoCAD一样操作ACADDOCUMENT对象，在指定图层写入一定大小的文字，并修改其颜色即可

heimj

还是不明白，请写具体代码。谢谢！！！

fjfhgdwfn

<pre class="Code">Sub Example_AddText()
    ' 该示例在模型空间中创建一个文字对象。

    Dim textObj As AcadText
    Dim textString As String
    Dim insertionPoint(0 To 2) As Double
    Dim height As Double
   
    ' 定义文字对象
    textString = "Hello, World."
    insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
    height = 0.5
   
    ' 在模型空间中创建文字对象
    Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
    ZoomAll
   
End Sub</pre><pre class="Code"></pre><pre class="Code">多看下VBA的帮助</pre>

alphasxb

     没有什么比vba的帮助好用的了          呵呵

ngeqt521

Option Explicit
Dim acadApp As AutoCAD.AcadApplication
Dim AcadDoc As AcadDocument

'标注文字
Dim Styleobj As AcadTextStyle '汉字字体集合
Set AcadDoc = acadApp.ActiveDocument
acadApp.Visible = acTrue
Set Styleobj = AcadDoc.TextStyles.Add("黑体")
Styleobj.fontFile = "c:\windows\fonts\simhei.ttf"
Set Styleobj = AcadDoc.TextStyles.Add("仿宋")
Styleobj.fontFile = "c:\windows\fonts\simfang.ttf"
Set Styleobj = AcadDoc.TextStyles.Add("楷体")
Styleobj.fontFile = "c:\windows\fonts\simkai.ttf"

AcadDoc.ActiveTextStyle = AcadDoc.TextStyles.Add("仿宋")

Dim addtext As AcadText
Dim textpoint As Variant
Dim textstring As String
 textpoint = returnpnt
  'textpoint(1) = textpoint(1) + 0.5
  Set addtext = AcadDoc.ModelSpace.addtext("你要写入到CAD的文字" , textpoint, 0.3)

Set layerobj = acadApp.ActiveDocument.Layers.Add("dotdesign") '创建一个层为DOTDESIGN
layerobj.color = acGreen '将创建的层指定为绿色
addtext.Update '指定对象到图层

Private Sub Form_Load()
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadApp = CreateObject("AutoCAD.Application")
If Err Then End
MsgBox ("你的系统未安装AutoCAD2004,请安装它才能使用本程序")
      Unload Me
      Exit Sub
      End If
acadApp.WindowState = acMax

acadApp.Visible = True
Set AcadDoc = acadApp.ActiveDocument
End Sub