如何修用VBA修改块名

qcw911

我想在复制的时候就修改块名
代码如下
但是VBA不能修改块名吗？
如何解决呢？


Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
    Debug.Print CommandName
    If StrComp(CommandName, "COPYCLIP", vbTextCompare) = 0 Then
         Dim ss As AcadSelectionSet
         Dim ent As AcadEntity
         Set ss = ThisDrawing.PickfirstSelectionSet
         If ss.Count = 0 Then Exit Sub
         Set ent = ss.Item(0)
          If ss.Count = 1 And TypeOf ent Is AcadBlockReference Then
              ent.Name = "CCC"
              Stop
          End If
     End If
End Sub

mikewolf2k

要这么获得块对象：
Set ent = ThisDrawing.Blocks(ss.Item(I).Name)

qcw911

mikewolf2k 发表于 2016-9-9 11:23
要这么获得块对象：
Set ent = ThisDrawing.Blocks(ss.Item(I).Name)

Set ent = ThisDrawing.Blocks(ss.Item(0).Name)
这样吗
这样没有通过

qcw911

我的主要问题是如何VBA修改块名呢
用lisp  rename倒是可以

mikewolf2k

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
     Debug.Print CommandName
     If StrComp(CommandName, "COPYCLIP", vbTextCompare) = 0 Then
          Dim ss As AcadSelectionSet
          Dim ent As AcadBlock
          Set ss = ThisDrawing.PickfirstSelectionSet
          If ss.Count = 0 Then Exit Sub
          Set ent = ThisDrawing.Blocks(ss.Item(I).Name)
          'Set ent = ss.Item(0)
          ' If ss.Count = 1 And TypeOf ent Is AcadBlockReference Then

               ent.Name = "CCC"
          '     Stop
           'End If
      End If
End Sub

qcw911

成功了
大神
Set ent = ThisDrawing.Blocks(ss.Item(I).Name)
i 怎么来的 默认为0？？

qcw911

mikewolf2k 发表于 2016-9-9 12:18
Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
     Debug.Print CommandName
   ...

设置不了最佳答案，不好意思只能送金币了

mikewolf2k

qcw911 发表于 2016-9-9 13:00
成功了
大神
Set ent = ThisDrawing.Blocks(ss.Item(I).Name)

不好意思，这段是从我原来代码拷过来的，忽略了这个I。在这段程序中I由于未定义默认是0，程序能够运行纯属巧合哈。这些错误你能够自行更正的。
问题的关键是要用thisdrawing.blocks方式来获得对象。