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

worker

谁能帮助我一下?熬3天了,坚持不住了,

问题是:

怎样用一个选择集创建一个图块,

worker

 

[SHADOW=255,blue,1]人呢？都哪里去了？[/SHADOW]

weihedao

   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)