社区 › VB › VBA创建图块的问题,我已经努力了,但做不到

worker 发表于 2006-12-8 02:18:00

VBA创建图块的问题,我已经努力了,但做不到

谁能帮助我一下?熬3天了,坚持不住了,
问题是:
怎样用一个选择集创建一个图块,

worker 发表于 2006-12-8 08:43:00

人呢？都哪里去了？

weihedao 发表于 2007-5-28 20:24:00

   Dim sset As AcadSelectionSet   ThisDrawing.SelectionSets.Item("path").Delete
    Set sset = ThisDrawing.SelectionSets.Add("path")
    Dim objs() As AcadEntity
    Dim zhongzhuan As Double
    Dim Entity As AcadEntity
   sset.SelectOnScreen '在屏幕上面选线段
   
   
    For Each Entity In sset '如果块已经定义则不需要重新定义
          If Entity.ObjectName = "AcDbBlockReference" Then '"AcDbBlockBegin"blockReference
             If Entity.Name = "sleeper" Then
            
            Set blockRefObj = Entity.Copy()
      '          MsgBox "wwww"
         GoTo insertkuai
         
               
               
               End If
          End If
    Next
   
   End
    Dim insertionPnt As Variant

    insertionPnt = ThisDrawing.Utility.GetPoint(, "拾取块的中点")
    Set blockObj = ThisDrawing.Blocks.Add _
                     (insertionPnt, "sleeper")
      For Each element In blockObj
      element.Delete
   Next
            


   ReDim objs(sset.Count - 1)
   Dim i
   For i = 0 To sset.Count - 1
         Set objs(i) = sset(i)
   Next i
   
   ThisDrawing.CopyObjects objs, blockObj      
   
   Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _
            (insertionPnt, "sleeper", 1#, 1#, 1#, 0)

查看完整版本: VBA创建图块的问题,我已经努力了,但做不到