修改 块 x y 比例

张火火、

我想修改选择块的比例。下面的代码是直接修改块的属性。但是不能成功，望大神指点！！

Sub 图框缩放()
Do
    Dim ds As Double
    Dim Ent As AcadEntity  '选择集对象
    Dim Ent1 As AcadEntity  '选择集对象
   On Error Resume Next
   ThisDrawing.Utility.GetEntity Ent, Pnt, "图框："
   ThisDrawing.Utility.GetEntity Ent1, Pnt1, "说明文字："
     If Pnt(0) = "" Then         '退出sub
      Exit Sub
      End If
    ds = Ent1.Height
    ds = ds / 3

   Ent.XScaleFactor = ds
   Ent.XEffectiveScaleFactor = ds

   Ent.YScaleFactor = ds
   Ent.YEffectiveScaleFactor = ds
      If Err <> 0 Then
        Exit Do
      End If
Loop
End Sub

marting

你应该对BlockReference  对象操作，而不是Entity

下面是个例子，你对照下看看

Sub Example_XScaleFactor()
    ' This example creates a block containing a circle.
    ' It then inserts the block and changes the XScaleFactor.
    
    ' Create the block
    Dim blockObj As AcadBlock
    Dim insertionPnt(0 To 2) As Double
    insertionPnt(0) = 0#: insertionPnt(1) = 0#: insertionPnt(2) = 0#
    Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
    
    ' Add a circle to the block
    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)
   
    ' Insert the block
    Dim blockRefObj As AcadBlockReference
    insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
    Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, "CircleBlock", 1#, 1#, 1#, 0)
    
    ' Find the current XScaleFactor for the block reference
    Dim currXScaleFactor As Double
    currXScaleFactor = blockRefObj.XScaleFactor
    ZoomAll
    MsgBox "The current XScaleFactor for the block reference is " & blockRefObj.XScaleFactor, , "XScaleFactor Example"
    
    ' Change the XScaleFactor for the block reference
    blockRefObj.XScaleFactor = currXScaleFactor + 2
    ZoomAll
    MsgBox "The new XScaleFactor for the block reference is " & blockRefObj.XScaleFactor, , "XScaleFactor Example"
    
End Sub