module1.bas

来自「Please read your package and describe it」· BAS 代码 · 共 70 行

Attribute VB_Name = "Module1"
  Option Explicit
  Public acadObj As Object
  Public newDimStyle As Object
  Public AcadDoc As Object 'AutoCAD文档(图形文件)对象
  Public moSpace As Object 'Model Space对象集合
  Public paSpace As Object 'Paper Space对象集合


Public Function AcadOpen()
    '以下连接AutoCAD R14
    On Error Resume Next
    Set acadObj = GetObject(, "AutoCAD.Application")
    If Err Then
        Set acadObj = CreateObject("AutoCAD.Application")
        Err.Clear
    End If
    acadObj.Visible = True
End Function

Public Function AcadLine(startPoint As Variant, endPoint As Variant)
    Dim anObj As Object
    '绘制直线
    Set anObj = acadObj.ActiveDocument.ModelSpace.AddLine(startPoint, endPoint)
End Function

Public Function AcadDimAligned(startPoint As Variant, endPoint As Variant, location As Variant)
    Dim anObj As Object
    '定位目标
    Set anObj = acadObj.ActiveDocument.ModelSpace.AddDimAligned(startPoint, endPoint, location)
End Function

Public Function AcadText(textString As String, startPoint As Variant, Height As Variant)
    Dim anObj As Object
    '写入文本
    Set anObj = acadObj.ActiveDocument.ModelSpace.AddText(textString, startPoint, Height)
End Function
Public Function AcadPLine(points As Variant)
    Dim anObj As Object
    '绘点creates a light weight polyline Object in model space
    Set anObj = acadObj.ActiveDocument.ModelSpace.AddPolyline(points)
End Function

Public Function AcadCircle(centerpoint As Variant, radius As Variant)
    Dim anObj As Object
    '绘制圆
    Set anObj = acadObj.ActiveDocument.ModelSpace.AddCircle(centerpoint, radius)
End Function

Public Function AcadLayer(LayerName As String, color As Integer)
    Dim anObj As Object
    '增加图层
    Set anObj = acadObj.ActiveDocument.Layers.Add(LayerName)
    anObj.color = color
    acadObj.ActiveDocument.ActiveLayer = anObj
End Function

Public Function AcadTextStyle(TextStyleName As String)
    '命名当前CAD字体
    Dim txtStyle As Object
    Dim currentTextStyle As Object
    
    Set txtStyle = acadObj.ActiveDocument.TextStyles.Add(TextStyleName)
    txtStyle.BigFontFile = "hztxt.shx"
    txtStyle.fontfile = "romans.shx"
    
    acadObj.ActiveDocument.ActiveTextStyle = txtStyle
End Function