• VB编程操作AutoCAD块对象


    块对象指Blocks集合对象和Block对象,Blocks对象包含一个图形文档中的所有命名的图块,Block对象则包含构成一个图块的所有实体对象,块对象的创建与引用包含3个步骤:用块对象的Add方法创建一个命名块,向块对象添加实体,用InsertBlock方法将该块插入到任何地方,即引用块。

    下面的代码创建一个块对象,并向块中添加一个圆,然后在不同位置插入该块对象。

    Private Sub Command1_Click()
        Dim blockobj As AcadBlock
        Dim insertionpnt(0 To 2) As Double
        insertionpnt(0) = 0#: insertionpnt(1) = 0#: insertionpnt(2) = 0#
        Set blockojb = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "circleblock")
        Dim circleobj As AcadCircle
        Dim center(0 To 2) As Double
        Dim radius As Double
        center(0) = 0: center(1) = 0: center(2) = 0
        radius = 1
        Set circleobj = blockobj.AddCircle(center, radius)
        Dim blockrefobj As AcadBlockReference
        Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "circleblock", 1#, 1#, 1#, 0)
        insertionpnt(0) = 5#: insertionpnt(1) = 2#: insertionpnt(2) = 0
        Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "Circleblock", 1#, 1#, 1#, 0)
        ZoomExtents
    End Sub

    当实体对象行程块,插入文档形成块引用时,可以用Explode方法将其炸开,重新获得单独的实体对象,然后就可以对块对象进行修改,或者添加、删除组成的实体对象。下面的代码创建一个块对象,想块中添加两个同心圆,将块对象插入文档形成引用对象,然后炸开块,改变两个同心圆的颜色,再删除块引用和第一个圆。

    Private Sub Command1_Click()
        Dim blockobj As AcadBlock
        Dim insertionpnt(0 To 2) As Double
        insertionpnt(0) = 0
        insertionpnt(1) = 0
        insertionpnt(2) = 0
        Set blockobj = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "circleblock")
        Dim circleobj1 As AcadCircle
        Dim circleobj2 As AcadCircle
        Dim center(0 To 2) As Double
        center(0) = 0
        center(1) = 0
        center(2) = 0
        Set circleobj1 = blockobj.AddCircle(center, 1)
        Set circleobj2 = blockobj.AddCircle(center, 3)
        Dim blockrefobj As AcadBlockReference
        insertionpnt(0) = 2
        insertionpnt(1) = 2
        insertionpnt(2) = 0
        Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "circleblock", 1#, 1#, 1#, 0)
        ZoomExtents
        MsgBox "图形"
        Dim explodedobjects As Variant
        explodedobjects = blockrefobj.Explode
        Dim i As Integer
        For i = 0 To UBound(explodedobjects)
            MsgBox "炸开"
            explodedobjects(i).Color = acRed
            explodedobjects(i).Update
        Next
        blockrefobj.Delete
        explodedobjects(0).Delete
    End Sub

    用AddAttribute方法可以创建块属性对象,块的属性可以给块添加文字,用来显示块的相关信息,将带有属性的块插入文档,创建一个块引用对象,可以从该块引用中提取并修改块属性信息,下面的代码创建一个块对象,向块对象中添加一个圆,然后创建块属性对象,再插入块,创建块引用对象,提取该对象引用属性并在消息框中显示属性标记,然后修改块属性,再次提取块引用属性并再消息框中显示属性标记和属性值。

    Private Sub Command1_Click()
        Dim blockobj As AcadBlock
        Dim insertionpnt(0 To 2) As Double
        insertionpnt(0) = 0
        insertionpnt(1) = 0
        insertionpnt(2) = 0
        Set blockobj = acadapp.ActiveDocument.Blocks.Add(insertionpnt, "testblock")
        Dim circleobj As AcadCircle
        Dim center(0 To 2) As Double
        Dim radius As Double
        center(0) = 0: center(1) = 0: center(2) = 0
        radius = 5
        Set circleobj = blockobj.AddCircle(center, radius)
        Dim attributeobj As AcadAttribute
        Dim height As Double
        Dim mode As Long
        Dim prompt As String
        Dim insertionpoint(0 To 2) As Double
        Dim tag As String
        Dim value As String
        height = 1#
        mode = acAttributeModeVerify
        prompt = "attribute prompt"
        insertionpoint(0) = 1
        insertionpoint(1) = 1
        insertionpoint(2) = 0
        tag = "attribute tag"
        value = "attribute value"
        Set attributeobj = blockobj.AddAttribute(height, mode, prompt, insertionpoint, tag, value)
        Dim blockrefobj As AcadBlockReference
        insertionpnt(0) = 2
        insertionpnt(1) = 2
        insertionpnt(2) = 0
        Set blockrefobj = acadapp.ActiveDocument.ModelSpace.InsertBlock(insertionpnt, "testblock", 1, 1, 1, 0)
        ZoomExtents
        Dim varattributes As Variant
        varattributes = blockrefobj.GetAttributes
        Dim strattributes As String
        strattributes = ""
        Dim i As Integer
        For i = LBound(varattributes) To UBound(varattributes)
            strattributes = strattributes + "tag:" + varattributes(i).TagString + vbCrLf + "value:" + varattributes(i).TextString
        Next
        MsgBox "引用"
        varattributes(0).TextString = "NEW VALUE"
        varattributes(0).Update
        Dim newvarattributes As Variant
        newvarattributes = blockrefobj.GetAttributes
        strattributes = ""
        For i = LBound(varattributes) To UBound(varattributes)
            strattributes = strattributes + "Tag:" + newvarattributes(i).TagString + vbCrLf + "value:" + newvarattributes(i).TextString
        Next
        MsgBox "块引用:"
    End Sub

    作者:codee
    文章千古事,得失寸心知。


  • 相关阅读:
    在 ServiceModel 客户端配置部分中,找不到引用协定
    nopi 导出excel 带图片
    c# async await 理解 结合并行处理
    从数据库更新模型时出现System.ArgumentException
    C# HTTP请求 异步(async await)
    C# HTTP请求
    SQL列转行
    详解C# 匿名对象(匿名类型)、var、动态类型 dynamic
    JavaScript (function (){}()) 与(function(){})()
    记ssh错误排查-ansible
  • 原文地址:https://www.cnblogs.com/bimgoo/p/2503148.html
Copyright © 2020-2023  润新知