Help me!怎样使用setcoustomscale方法

waitingyou

怎样使用setcoustomscale方法，望高手赐教

yulijin608

语法

object.SetCustomScale(Numerator, Denominator)

Object

Layout, PlotConfiguration
使用该方法的对象。

Numerator

Double[双精度]; 仅用于输入
用正数表示的比率中的分子。该值表示比例的英寸或毫米数。

Denominator

Double[双精度]; 仅用于输入
用正数表示的比率中的分母。该值表示比例的图形单位数。

说明

Numerator 参数的单位可在 PaperUnits 属性中查到。

Numerator 和 Denominator 值必须大于 0。

该方法的产生的改动在图形重生成时不会显示。使用 Regen 方法重生成图形。

Sub Example_SetCustomScale()
' This example will access the Layouts collection for the current drawing
' and list basic information about the custom scale for each Layout.
' It will then change the custom scale information for model space and re-display
' the scale information.

Dim Layouts As AcadLayouts, Layout As ACADLayout
Dim msg As String
Dim Numerator As Double, Denominator As Double
Dim Measurement As String

' Display current scale information
GoSub DISPLAY_SCALE_INFO

' Modify scale
Numerator = 1
Denominator = 1

ThisDrawing.Layouts("Model").SetCustomScale Numerator, Denominator
ThisDrawing.Regen acAllViewports

' Display new scale information
GoSub DISPLAY_SCALE_INFO

Exit Sub

DISPLAY_SCALE_INFO:
    ' Get layouts collection from document object
    Set Layouts = ThisDrawing.Layouts
    
    msg = vbCrLf & vbCrLf   ' Start with a space
    
    ' Get the scale information of every layout in this drawing
    For Each Layout In Layouts
        msg = msg & Layout.name & vbCrLf
        
        ' Get scale information
        Layout.GetCustomScale Numerator, Denominator
        
        ' Identify whether inches or millimeters are being used.
        Measurement = IIf(Layout.PaperUnits = acInches, " inch(es)", " millimeter(s)")
        
        ' Format for display
        msg = msg & vbTab & "Contains " & Numerator & Measurement & vbCrLf
        msg = msg & vbTab & "Contains " & Denominator & " drawing units" & vbCrLf
        msg = msg & "_____________________" & vbCrLf
        
    Next
    
    ' Display custom scale information
    MsgBox "Custom scale information for the current drawing is: " & msg
    
    Return
End Sub