?'COPYRIGHT DASSAULT SYSTEMES 2001
' ****************************************************************************
' Purpose: To draw a Frame and TitleBlock
' Assumptions: A Drafting document should be active
' Author: 彭阳国
' Languages: VBScript--catia automation
' Version: V5R14
' Release:
' #2011-7-20 by 16969
' ****************************************************************************
Public DrwDocument As DrawingDocument
Public DrwSheets As DrawingSheets
Public DrwSheet As DrawingSheet
Public DrwView As DrawingView
Public DrwTexts As DrawingTexts
Public Text As DrawingText
Public Fact As Factory2D
Public Point As Point2D
Public Line As Line2D
Public Circle As Circle2D
Public Selection As Selection
Public GeomElems As GeometricElements
Public Height As Double 'Sheet height
Public Width As Double 'Sheet width
Public Offset As Double 'Distance between the sheet edges and the frame borders
Public OH As Double 'Horizontal origin for drawing the titleblock
Public OV As Double 'Vertical origin for drawing the titleblock
Public Col(20) As Double 'Columns coordinates
Public Row(18) As Double 'Rows coordinates
Public colRev(4) As Double 'Columns coordinates of revision block
Public TranslationX As Double 'Horizontal translation to operate when changing standard
Public TranslationY As Double 'Vertical translation to operate when changing standard
Public displayFormat As String 'Sheet format according to standard
Public sheetFormat As catPaperSize 'Sheet format as integer value
'new variable
Public RowWidth As Double 'Sheet width
Public ObjAmount As Double
Public Coll(8) As Double 'Collumns coordinates
'Const MaxDetailSec as Integer = 53 '明细栏的最大数量
'Public Rowl(53) As Double 'Rowls coordinates ObjAmount=i+3
'end
Const MaxDetailSec = 53
Dim Rowl() as Double
Const mm = 1
Const Inch = 254
Const RulerLength = 200
Const MacroID = "Drawing_Titleblock_JUNJIE"
Const RevRowHeight = 10
' Add by 16969
' Used to change the width of lines
Dim oSel as Selection
Dim OVisProps as VisPropertySet
Const FatLine as Long = 2 ' the fat line number of the line width defined in XML configration file.
Const FineLine as Long = 1 ' the fine line number of the line width defined in XML configration file
' Sheet Background view's name
Const SheetBackground as String = "Background View"
' 字符串字符的间隔比例
Const CharSpacing as Integer = 10
' 字符串字符的比率值, 注意: 仅支持Catia中的矢量字体, TrueType字体无效.
Const CharRatio as Integer = 85
Sub CATMain()
CATInit
On Error Resume Next
Name = DrwTexts.GetItem("Refer
ence_" + MacroID).Name
If Err.Number <> 0 Then
Err.Clear
Name = "none"
End If
On Error GoTo 0
If (Name = "none") Then
CATDrw_Creation
End If
End Sub
Sub CATDrw_Creation()
'-------------------------------------------------------------------------------
'How to create the FTB
'-------------------------------------------------------------------------------
CATInit 'To init public variables & work in the background view
If CATCheckRef(1) Then Exit Sub 'To check whether a FTB exists already in the sheet
CATStandard 'To compute standard sizes
CATReference 'To place on the drawing a reference point
CATFrame 'To draw the frame
CATTitleBlock 'To draw the TitleBlock and fill in it
'******************************
'If ObjAmount>0 Then
' CATTitleObjBlock 'To draw the TitleBlock and fill in it
' Else Exit Sub
' End If
'******************************
End Sub
Sub CATInit()
'-------------------------------------------------------------------------------
'How to init the dialog and create main objects
'-------------------------------------------------------------------------------
Set DrwDocument = CATIA.ActiveDocument
Set DrwSheets = DrwDocument.Sheets
Set Selection = DrwDocument.Selection
Set DrwSheet = DrwSheets.ActiveSheet
Set DrwView = DrwSheet.Views.ActiveView
Set DrwTexts = DrwView.Texts
Set Fact = DrwView.Factory2D
Set GeomElems = DrwView.GeometricElements
' switch to "Sheet Background"
Dim curViewName as String
Dim viewIdent as String
Dim viewSuffix as String
DrwView.GetViewName curViewName, viewIdent, viewSuffix
if (curViewName <> SheetBackground) then
set DrwView = DrwSheet.Views.Item(SheetBackground)
DrwView.Activate
end if
ReDim Rowl(MaxDetailSec)
End Sub
Sub CATStandard()
'-------------------------------------------------------------------------------
'How to compute standard values 如何计算标准值
'-------------------------------------------------------------------------------
Height = DrwSheet.GetPaperHeight '图纸高
Width = DrwSheet.GetPaperWidth '图纸宽
sheetFormat = DrwSheet.PaperSize '纸张格式A0-A4
Offset = 5.*mm 'Offset default value = 10.
If (sheetFormat = CatPaperA0 Or sheetFormat = CatPaperA1 Or sheetFormat = CatPaperA2 Or sheetFormat = CatPaperUser And _
(DrwSheet.GetPaperWidth > 420.*mm Or DrwSheet.GetPaperHeight > 420.*mm)) Then
Offset = 10.*mm
End If
OH = Width - Offset
OV = Offset
documentStd = DrwDocument.Standard
If (documentStd = catISO) Then
If sheetFormat = 13 Then
displayFormat = "USER"
Else
displayFormat = "A" + CStr(sheetFormat - 2)
End If
Else
Select Case sheetFormat
Case 0
displayFormat = "Letter"
Case 1
displayFormat = "Legal"
Case 7
displayFormat = "A"
Case 8
displayFormat = "B"
Case 9
displayFormat = "C"
Case
10
displayFormat = "D"
Case 11
displayFormat = "E"
Case 12
displayFormat = "F"
Case 13
displayFormat = "J"
End Select
End If
End Sub
Sub CATReference()
'-------------------------------------------------------------------------------
'How to create a reference text
'-------------------------------------------------------------------------------
Set Text = DrwTexts.Add("", Width - Offset, Offset)
https://www.doczj.com/doc/698597123.html, = "Reference_" + MacroID
End Sub
Function CATCheckRef(Mode As Integer) As Integer
'-------------------------------------------------------------------------------
'How to check that the called macro is the right one
'-------------------------------------------------------------------------------
nbTexts = DrwTexts.Count
i = 0
notFound = 0
While (notFound = 0 And i
Set Text = DrwTexts.Item(i)
WholeName = https://www.doczj.com/doc/698597123.html,
leftText = Left(WholeName, 10)
If (leftText = "Reference_") Then
notFound = 1
refText = "Reference_" + MacroID
If (Mode = 1) Then
MsgBox "Frame and Titleblock already created!"
CATCheckRef = 1
Exit Function
ElseIf (https://www.doczj.com/doc/698597123.html, <> refText) Then
MsgBox "Frame and Titleblock created using another style:" + Chr(10) + " " + MacroID
CATCheckRef = 1
Exit Function
End If
End If
Wend
CATCheckRef = 0
End Function
Sub CATFrame()
'-------------------------------------------------------------------------------
'How to create the Frame 如何创建图框
'-------------------------------------------------------------------------------
Dim Cst_1 As Double 'Length (in cm) between 2 horinzontal marks
Dim Cst_2 As Double 'Length (in cm) between 2 vertical marks
Dim Nb_CM_H As Integer 'Number/2 of horizontal centring marks
Dim Nb_CM_V As Integer 'Number/2 of vertical centring marks
Dim Ruler As Integer 'Ruler length (in cm)
CATFrameStandard Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
CATFrameBorder
End Sub
Sub CATFrameStandard(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
'-------------------------------------------------------------------------------
'How to compute standard values
'-------------------------------------------------------------------------------
Cst_1 = 74.2*mm '297, 594, 1189 are multiples of 74.2
Cst_2 = 52.5*mm '210, 420, 841 are multiples of 52.2
If DrwSheet.Orientation = CatPaperPortrait And _
(sheetFormat = CatPaperA0 Or _
sheetFormat = CatPaperA2 Or _
sheetFormat = CatPaperA4) Or _
DrwSheet.Orientation = CatPaperLandscape And _
(sheetFormat = CatPaperA1 Or _
sheetFormat = CatPaperA3) Then
Cst_1 = 52.5*mm
Cst_2 = 74.2*mm
End If
Nb_CM_H = CInt(.5 * Width / Cst_1)
Nb_CM_V = CInt(.5 * Height / Cst_2)
Ruler = CInt((Nb_CM_H - 1) * Cst_1 / 50) * 100 'here is computed the maximum ruler length
If Ru
lerLength < Ruler Then
Ruler = RulerLength
End If
End Sub
Sub CATFrameBorder()
'-------------------------------------------------------------------------------
'How to draw the frame border 如何画边框
'-------------------------------------------------------------------------------
On Error Resume Next
Set Line = Fact.CreateLine(0,0 , Width, 0 )
https://www.doczj.com/doc/698597123.html, = "Frame_Line_Bottom"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0, 0 , 0, Height)
https://www.doczj.com/doc/698597123.html, = "Frame_Line_Left"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0, Height, Width, Height)
https://www.doczj.com/doc/698597123.html, = "Frame_Line_Top"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(Width, Height, Width, 0 )
https://www.doczj.com/doc/698597123.html, = "Frame_Line_Right"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(25, OV , OH, OV )
https://www.doczj.com/doc/698597123.html, = "Frame_Border_Bottom"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(25, OV , 25, Height - Offset)
https://www.doczj.com/doc/698597123.html, = "Frame_Border_Left"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(25, Height - Offset, OH, Height - Offset)
https://www.doczj.com/doc/698597123.html, = "Frame_Border_Top"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(OH, Height - Offset, OH, OV )
https://www.doczj.com/doc/698597123.html, = "Frame_Border_Right"
ChgLineThickness Line, FatLine
If Err.Number <> 0 Then
Err.Clear
End If
On Error GoTo 0
End Sub
Sub CATTitleBlock()
'-------------------------------------------------------------------------------
'How to create the TitleBlock 如何创建标题块
'-------------------------------------------------------------------------------
CATTitleBlockFrame 'To draw the geometry
CATTitleBlockText 'To fill in the title block
If ObjAmount>0 Then
CATTitleObjBlock 'To draw the TitleObjBlock and fill in it
Else Exit Sub
End If
End Sub
Sub CATTitleObjBlock()
'-------------------------------------------------------------------------------
'How to create the TitleObjBlock
'-------------------------------------------------------------------------------
CATTitleObjBlockFrame 'To draw the geometry
CATTitleObjBlockText 'To fill in the title Objblock
End Sub
Sub CATTitleBlockFrame()
'-------------------------------------------------------------------------------
'How to draw the title block geometry
'-------------------------------------------------------------------------------
ObjAmount= InputBox("1.输入“0”或单击“取消” →零件图标题栏； 2.输入零件个数“≥1” →带有明细栏的装配图标题栏", "零部件数量", 0)
If( ObjAmount<2 And ObjAmount>101 )Then
ObjAmount= InputBox("请输入零件的数目(不大于101不小于2。)：" )
End If
' 明细栏的最大
栏数目定义在文件头部的MaxDetailSec常数, 修改它可以录入更多明细
' 但是须注意图纸图幅大小, 过大的栏数目会导致明细栏绘制到图纸外界.
if (CInt(ObjAmount) > (MaxDetailSec - 3)) then
msgbox "零部件数量超出最大值" & CStr(MaxDetailSec - 3) & Chr(13) & "系统按默认最大值处理", _
vbOKOnly + vbExclamation, "警告"
ObjAmount = MaxDetailSec - 3
end if
RowWidth = + 6*mm 'Define rows Rowwidth 定义行宽.
Const Rows = 13 'Define how many rows 定义多少行.
'Col 列距赋值
Col(1) = -180*mm
Col(2) = -172*mm
Col(3) = -170*mm
Col(4) = -165*mm
Col(5) = -150*mm
Col(6) = -145*mm
Col(7) = -140*mm
Col(8) = -130*mm
Col(9) = -120*mm
Col(10) = -112.5*mm
Col(11) = -105*mm
Col(12) = -97.5*mm
Col(13) = -90*mm
Col(14) = -75*mm
Col(15) = -60*mm
'Row 行距赋值
Row(1) = + 6*mm
Row(2) = + 14*mm
Row(3) = + 15*mm
Row(4) = + 20*mm
Row(5) = + 30*mm
Row(6) = + 36*mm
Row(7) = + 45*mm
Row(8) = + 5*mm
Row(9) = + 10*mm
Row(10) = + 15*mm
Row(11) = + 45*mm 'revised 图框顶高
On Error Resume Next
'Rows 划标题栏底顶横线
Set Line = Fact.CreateLine(OH + Col(1), OV , OH, OV)
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Bottom"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(OH+Col(1), OV +Row(11), OH, OV +Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Top"
ChgLineThickness Line, FatLine
'Line "TitleBlock_Border_Top".BorderWidth =5 标题栏顶宽＝5
'标题栏中右行线
Set Line = Fact.CreateLine(OH +Col(9),OV + Row(1), OH +Col(15) , OV + Row(1))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_1"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH +Col(9), OV +Row(2), OH+Col(15), OV +Row(2))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_2"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH +Col(15),OV +Row(3) , OH , OV +Row(3))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_3"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(1), OV +Row(4), OH+Col(15) , OV +Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_4"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(15), OV +Row(5), OH , OV +Row(5))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_5"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(9), OV +Row(6), OH+Col(15) , OV +Row(6))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_6"
ChgLineThickness Line, FineLine
'停 Set Line = Fact.CreateLine(( OH + Col(1)+25)/2, OV +Row(7),( OH + Col(1)+25)/2 , OV +Row(6))
'停 https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Row_7"
'停 ChgLineThickness Line, FatLine
'标题栏左下行线
Set Line = Fact.CreateLine(OH +Col(1), OV +Row(8), OH +Col(9) , OV +Row(8))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_8"
ChgLineThickness Line, FineLine
Set Line = Fac
t.CreateLine(OH +Col(1), OV +Row(9), OH +Col(9) , OV +Row(9))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_9"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(1), OV +Row(10), OH +Col(9), OV +Row(10))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_10"
ChgLineThickness Line, FineLine
'标题栏左上行线
Set Line = Fact.CreateLine(OH + Col(1), OV +Row(4) + (5*1), OH+ Col(9) , OV +Row(4) + (5*1))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_LeftRow_1"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Col(1), OV +Row(4) + (5*2), OH+ Col(9) , OV +Row(4) + (5*2))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_LeftRow_2"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Col(1), OV +Row(4) + (5*3), OH+ Col(9) , OV +Row(4) + (5*3))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_LeftRow_3"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Col(1), OV +Row(4) + (5*4), OH+ Col(9) , OV +Row(4) + (5*4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_LeftRow_4"
ChgLineThickness Line, FineLine
' 划左上角图号行列线
Set Line = Fact.CreateLine(25, Height-Offset-12, 25+60 , Height-Offset-12)
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Row_10"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(25+60, Height-Offset , 25+60, Height - Offset-12)
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_7"
ChgLineThickness Line, FineLine
' 划右上角轴侧图行列线
Set Line = Fact.CreateLine(OH -47, Height-Offset-36, OH , Height-Offset-36)
https://www.doczj.com/doc/698597123.html, = "TitleBlock_RightLine_Row_1"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH -47, Height-Offset , OH -47, Height - Offset-36)
https://www.doczj.com/doc/698597123.html, = "TitleBlock_RightLine_Column_1"
ChgLineThickness Line, FineLine
'左装订线旧底图行线
Set Line = Fact.CreateLine(0 , OV , 25 , OV )
https://www.doczj.com/doc/698597123.html, = "Left_Line_1"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+10 , 25 , OV+10 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_2"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+17 , 25 , OV+17 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_3"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+27 , 25 , OV+27 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_4"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+34 , 25 , OV+34 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_5"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+44 , 25 , OV+44 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_6"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+51 , 25 , OV+51 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_7"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(
0 , OV+61 , 25 , OV+61 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_8"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+68 , 25 , OV+68 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_9"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+78 , 25 , OV+78 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_10"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(0 , OV+85 , 25 , OV+85 )
https://www.doczj.com/doc/698597123.html, = "Left_Line_11"
ChgLineThickness Line, FineLine
' Set Line = Fact.CreateLine(0 , OV+95 , 25 , OV+95 )
' https://www.doczj.com/doc/698597123.html, = "Left_Line_10"
' ChgLineThickness Line, FineLine
' Set Line = Fact.CreateLine(0 , OV+102 , 25 , OV+102 )
' https://www.doczj.com/doc/698597123.html, = "Left_Line_11"
' ChgLineThickness Line, FineLine
'Cols 划左右列边线
Set Line = Fact.CreateLine(OH + Col(1), OV, OH + Col(1), OV +Row(11) )
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Left"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(OH , OV , OH, OV + Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Right"
ChgLineThickness Line, FatLine
' 划标题栏左列线
Set Line = Fact.CreateLine(OH+Col(2), OV + Row(4), OH+Col(2), OV + Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_1"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(3), OV, OH+Col(3), OV + Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_2"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(4), OV+ Row(4) , OH+Col(4), OV + Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_3"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(5), OV, OH+Col(5), OV + Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_4"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(6), OV+Row(4) , OH+Col(6), OV +Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_5"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(7), OV, OH+Col(7), OV + Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_6"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(8), OV+Row(4), OH+Col(8), OV +Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Column_7"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(9), OV, OH+Col(9), OV +Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_8"
ChgLineThickness Line, FatLine
Set Line = Fact.CreateLine(OH+Col(10), OV+Row(1) , OH+Col(10), OV +Row(2))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Border_Column_9"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(11), OV+Row(1), OH+Col(11), OV +Row(2))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_line_Column_10"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(12), OV+Row(1), OH+Col(12), OV +R
ow(2))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_11"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(13), OV, OH+Col(13), OV+Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_12"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(14), OV+Row(1), OH+Col(14), OV+Row(4))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_12"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH+Col(15), OV, OH+Col(15), OV+Row(11))
https://www.doczj.com/doc/698597123.html, = "TitleBlock_Line_Column_12"
ChgLineThickness Line, FatLine
' 生成标题栏文字
If Err.Number <> 0 Then
Err.Clear
End If
On Error GoTo 0
End Sub
Sub CATTitleBlockText()
'-------------------------------------------------------------------------------
'How to fill in the title block 如何填充标题栏文字
'-------------------------------------------------------------------------------
CATLinks
'The Left subBlock 装订线左子块增加宏华标准.
Text_01 = "页 次"
Text_02 = "零件类别"
Text_03 = "更改次数"
Text_04 = "代替版本号"
Text_35 = "版 本 号"
Text_36 = " "
Text_42 = " "
'The Left-up subBlock 左上子块.
Text_05 = "标记"
Text_06 = "处数"
Text_07 = "更改文件号"
Text_08 = "签 字"
Text_09 = "日 期"
'The Left-down subBlock.
'停 Text_10 = "重要度等级"
'停 Text_11 = "Q"
'停 Text_12 = "法规性等级"
'停 Text_13 = "保安性等级"
'The Middle subblock
Text_14 = "共 1 张"
Text_15 = "第 1 张"
Text_16 = "比 例"
Text_17= " 1 ： 2"
Text_18 = "质 量"
Text_19 = "(零件名称)"
Text_20 = "项目代号"
Text_23 = " kg"
Text_37 = "(材 料)"
Text_38 = "图 样 标 记"
'The right subblock
Text_21 = "嘉陵制造有限公司"
Text_22 ="设 计"
Text_24 ="校 核"
Text_26 ="审 核"
Text_28 ="工 艺"
Text_30 ="标准化"
Text_32 ="批 准"
Text_33 = "日 期"
Text_34 =" (图 号)"
Text_39 =" (图 号)"
Text_25 = "技术要求"
Text_27 = "1、去除零件表面毛刺，未注圆角R2；"
Text_29 = "2、零件外观应平整光洁、无破裂、拉伤及不"
Text_31 = " 良变形等常见冲压缺陷，毛刺应≤0.3；"
Text_40 = "3、未注公差按GB/T15055-2007-m执行；"
Text_41 = "4、未注尺寸参照3D模型。"
'The Left subBlockText 左子块文字改为宏华标准.
Set Text = DrwTexts.Add(Text_01 , 6 , OV+11.5 )
CATFormatTBText "TitleBlock_Text_01" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_02 , 7 , OV + 28.5 )
CATFormatTBText "TitleBlock_Text_02" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_03 , 7 , OV + 45.5 )
CATFormatTBText "TitleBlock_Text_03" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_04 ,6 , OV + 62.5 )
CATFormatTBText "TitleBlo
ck_Text_04" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_35 ,7 , OV + 79.5 )
CATFormatTBText "TitleBlock_Text_35" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_36 ,10 , OV + 3 )
CATFormatTBText "TitleBlock_Text_36" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_36 ,10 , OV + 20 )
CATFormatTBText "TitleBlock_Text_36" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_36 ,11 , OV + 37 )
CATFormatTBText "TitleBlock_Text_36" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_42 ,5 , OV + 54 )
CATFormatTBText "TitleBlock_Text_42" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_42 ,5 , OV + 71 )
CATFormatTBText "TitleBlock_Text_42" ,catBottomLeft , 4
'The Left-down subBlockText 左上子块文字.
Set Text = DrwTexts.Add(Text_05 , OH + Col(1)+1.5 , OV+20.5 )
CATFormatTBText "TitleBlock_Text_05" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_06 , OH + Col(2)+1 , OV + 20.5 )
CATFormatTBText "TitleBlock_Text_06" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_07 , OH + Col(4)+3.5 , OV +20.5 )
CATFormatTBText "TitleBlock_Text_07" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_08 , OH + Col(6)+3.8 , OV+ 20.5 )
CATFormatTBText "TitleBlock_Text_08 " ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_09 , OH + Col(8)+1.5 , OV+20.5 )
CATFormatTBText "TitleBlock_Text_09 " ,catBottomLeft , 4
'The Left-up subBlockText.
Set Text = DrwTexts.Add(Text_10 , OH + Col(1)+2 , OV + Row(10)+7 )
CATFormatTBText "TitleBlock_Text_10" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_11 , OH + Col(4) + 7. , OV+Row(10)+1 )
CATFormatTBText "TitleBlock_Text_11 " ,catBottomLeft , 4
'圆 Set Circle = Fact.CreateClosedCircle(OH + Col(4) + 8, OV+Row(10)+3, 2.5)
'圆 https://www.doczj.com/doc/698597123.html, = "TitleBlock_line_Circle_1"
Set Text = DrwTexts.Add(Text_12 , OH + Col(1)+2 , OV+ Row(10) +1 )
CATFormatTBText "TitleBlock_Text_12 " ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_13 , OH + Col(4)+2 , OV+Row(10)+7 )
CATFormatTBText "TitleBlock_Text_13" ,catBottomLeft , 4
'The Middle subblockText.
Set Text = DrwTexts.Add(Text_14 , OH + Col(9) + 5.5 , OV+1 )
CATFormatTBText "TitleBlock_Text_14 " ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_15 , OH + Col(13) + 5.5 , OV+1 )
CATFormatTBText "TitleBlock_Text_15" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_16 , OH + Col(14) + 4. , OV +Row(2)+1 )
CATFormatTBText "TitleBlock_Text_16" ,catBottomLeft , 4
Set Text = DrwTexts.Add(Text_17 , OH + Col(14) + 2 , OV +Row(1)+2
)
CATFormatTBText "TitleBlock_Text_17" ,catBottomLeft , 4
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_18 , OH + Col(13) + 4. , OV +Row(2)+1 )
CATFormatTBText "TitleBlock_Text_18" ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_19 , OH + Col(15)+30 , OV +Row(3)+4 )
CATFormatTBTextHw "TitleBlock_Text_19" ,catBottomCenter , 6
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_20 , OH + Col(9)+30 , OV +Row(6)+2 )
CATFormatTBTextHw "TitleBlock_Text_20" ,catBottomCenter, 5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_37 , OH + Col(9)+30 , OV +Row(4)+5 )
CATFormatTBTextHw "TitleBlock_Text_20" ,catBottomCenter, 5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_38 , OH + Col(9) + 6. , OV +Row(2)+1 )
CATFormatTBText "TitleBlock_Text_38" ,catBottomLeft , 4
'The right subblockText.
Set Text = DrwTexts.Add(Text_21, OH + Col(15) +30, OV +Row(5)+4)
CATFormatTBText "TitleBlock_Text_21l" ,catBottomCenter, 6
Set Text = DrwTexts.Add(Text_22 , OH + Col(1)+1.5, OV +Row(10)+0.5)
CATFormatTBText "TitleBlock_Text_22" ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_23 , OH + Col(13)+2.2, OV +Row(1)+2)
CATFormatTBText "TitleBlock_Text_23 " ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_24 , OH + Col(1)+1.5, OV +Row(9)+0.5)
CATFormatTBText "TitleBlock_Text_24l" ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_26 , OH + Col(1)+1.5 , OV +Row(8)+0.5)
CATFormatTBText "TitleBlock_Text_26 " ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_28 , OH + Col(1)+1.5 , OV+0.5)
CATFormatTBText "TitleBlock_Text_28l" ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_30 , OH + Col(5)+1.2, OV +Row(10)+0.5)
CATFormatTBText "TitleBlock_Text_30 " ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_32 , OH + Col(5)+1.5 , OV +Row(8)+0.5)
CATFormatTBText "TitleBlock_Text_32" ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_33 , OH + Col(5)+1.5 , OV +0.5)
CATFormatTBText "TitleBlock_Text_33 " ,catBottomLeft, 4
Set Text = DrwTexts.Add(Text_34 , OH + Col(15)+30, OV +4)
CATFormatTBTextHw "TitleBlock_Text_34" ,catBottomCenter, 6
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_39 , 55, Height-Offset-9)
CATFormatTBTextHw "TitleBlock_Text_39" ,catBottomCenter, 6
Text.SetFontName 0, 0, "SICH"
'技术要求编辑
Set Text = DrwTexts.Add(Text_25 , ( OH + Col(1)+25)/2-12, 46)
CATFormatTBTextHw "TitleBlock_Text_25" ,catBottomLeft, 5.5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_27 , ( OH + Col(1)+25)/2-39, 38)
CATFormatTBText
Hw "TitleBlock_Text_27" ,catBottomLeft, 4.5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_29 , ( OH + Col(1)+25)/2-40, 31)
CATFormatTBTextHw "TitleBlock_Text_29" ,catBottomLeft, 4.5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_31 , ( OH + Col(1)+25)/2-40, 24)
CATFormatTBTextHw "TitleBlock_Text_31" ,catBottomLeft, 4.5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_40 , ( OH + Col(1)+25)/2-40, 17)
CATFormatTBTextHw "TitleBlock_Text_40" ,catBottomLeft, 4.5
Text.SetFontName 0, 0, "SICH"
Set Text = DrwTexts.Add(Text_41 , ( OH + Col(1)+25)/2-40, 10)
CATFormatTBTextHw "TitleBlock_Text_41" ,catBottomLeft, 4.5
Text.SetFontName 0, 0, "SICH"
' 左视窗参数设置
Dim doc As DrawingDocument
Dim param As Parameter 'TitleBlock_Text_20
Dim txt As DrawingText
Set doc = DrwDocument 'CATIA.ActiveDocument
'图号
Set param = doc.Parameters.CreateString("下图号", "(下 图 号)")
Set Text = doc.Sheets.ActiveSheet.Views.ActiveView.Texts.GetItem("TitleBlock_Text_34")
Text.InsertVariable 1, Len(Text.Text), param
Set param = doc.Parameters.CreateString("上图号", "(上 图 号)")
Set Text = doc.Sheets.ActiveSheet.Views.ActiveView.Texts.GetItem("TitleBlock_Text_39")
Text.InsertVariable 1, Len(Text.Text), param
'项目代号
Set param = doc.Parameters.CreateString("产品代号", "产品代号")
Set Text = doc.Sheets.ActiveSheet.Views.ActiveView.Texts.GetItem("TitleBlock_Text_20")
Text.InsertVariable 1, Len(Text.Text), param
'零件名称
Set param = doc.Parameters.CreateString("零件名称", "(零件名称)")
Set Text = doc.Sheets.ActiveSheet.Views.ActiveView.Texts.GetItem("TitleBlock_Text_19")
Text.InsertVariable 1, Len(Text.Text), param
End Sub
Sub CATTitleObjBlockFrame()
'-------------------------------------------------------------------------------
'How to draw the title Objblock geometry 如何设计明细栏
'-------------------------------------------------------------------------------
Coll(1) = -180*mm
Coll(2) = -172*mm
Coll(3) = -132*mm
Coll(4) = -88*mm
Coll(5) = - 80*mm
Coll(6) = - 42*mm
Coll(7) = - 32*mm
Coll(8) = - 20*mm
Rowl(1) = + 45*mm
Rowl(2) = + 52*mm
Rowl(3) = + 59*mm
For i=1 To ObjAmount
Rowl(i+3)= + (59+7*i)*mm
Next
'MsgBox "Frame and Titleblock already created!"
On Error Resume Next
'creat TitleObjBlock RowlLines 创建明细栏的横线.
Set Line = Fact.CreateLine(OH +Coll(6), OV +Rowl(2) , OH+Coll(8) , OV + Rowl(2) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_ShotLine_Bottom"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(3) , OH , OV + Rowl(3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_RowlLine_Bottom"
ChgLineThickness Line, FineLine
For i=1 To
ObjAmount
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(i+3) , OH , OV + Rowl(i+3))
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_RowlLine_No." & i
ChgLineThickness Line, FineLine
Next
'creat TitleObjBlock CollLines 创建明细栏的列线.
Set Line = Fact.CreateLine(OH + Coll(8), OV +Rowl(1) , OH+ Coll(8) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.8"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(7), OV +Rowl(2) , OH+ Coll(7) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.7"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(6), OV +Rowl(1) , OH+ Coll(6) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.6"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(5), OV +Rowl(1) , OH+ Coll(5) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.5"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(4), OV +Rowl(1) , OH+ Coll(4) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.4"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(3), OV +Rowl(1) , OH+ Coll(3) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.3"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(2), OV +Rowl(1) , OH+ Coll(2) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.2"
ChgLineThickness Line, FineLine
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(1) , OH+ Coll(1) , OV + Rowl( ObjAmount+3) )
https://www.doczj.com/doc/698597123.html, = "TitleObjBlock_Collline_No.1"
ChgLineThickness Line, FineLine
If Err.Number <> 0 Then
Err.Clear
End If
On Error GoTo 0
End Sub
Sub CATTitleObjBlockText()
'-------------------------------------------------------------------------------
'How to fill in the title Objblock 如何填写明细栏文字.
'----------------------------------------------------------------------------
Text_01 = "序"
Text_02 = "号"
Text_03 = Chr(15) +"代 号"
Text_04 = Chr(15) +" 名 称"
Text_05 = "数"
Text_06 = "量"
Text_07 = Chr(20) +" 材 料"
Text_08 = "单 件"
Text_09 = "总 计"
Text_10 = Chr(10) +"重 量"
Text_11 = Chr(15) +"备 注"
TextO_01 = " "
TextO_02 = " "
TextO_03 = " "
TextO_04 = " "
TextO_05 = " "
TextO_06 = " "
TextO_07 = " "
TextO_08 = " "
Set Text = DrwTexts.Add(Text_01, OH + Coll(1)+2 , OV + (Rowl(2)+1) )
CATFormatTBText "ObjTitleBlock_Text_xu" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_02, OH + Coll(1) + 2. , O
V + (Rowl(1)+2) )
CATFormatTBText "ObjTitleBlock_Text_hao" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_03, OH + Coll(2) + 4. , OV + (Rowl(1)+4) )
CATFormatTBText "ObjTitleBlock_Text_Cname" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_04, OH + Coll(3) + 3. , OV + (Rowl(1)+4) )
CATFormatTBText "ObjTitleBlock_Text_Name" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_05, OH + Coll(4) + 2. , OV + (Rowl(2)+1) )
CATFormatTBText "ObjTitleBlock_Text_shu" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_06, OH + Coll(4) + 2. , OV + (Rowl(1)+2) )
CATFormatTBText "ObjTitleBlock_Text_liang" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_07, OH + Coll(5) + 1. , OV + (Rowl(1)+4) )
CATFormatTBText "ObjTitleBlock_Text_Materia" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_08, OH + Coll(6) + 2 , OV + Rowl(2)+1 )
CATFormatTBText "ObjTitleBlock_Text_Single" , catBottomLeft , 4
Set Text = DrwTexts.Add(Text_09, OH + Coll(7) + 2. , OV + Rowl(2)+1 )
CATFormatTBText "ObjTitleBlock_Text_Amount" , catBottomLeft , 4
Set Text = DrwTexts.Add(Text_10, OH + Coll(6) + 4. , OV +Rowl(1)+1 )
CATFormatTBText "ObjTitleBlock_Text_weigt" , catBottomLeft , 4
Set Text = DrwTexts.Add(Text_11, OH + Coll(8) + 1. , OV + (Rowl(1)+4) )
CATFormatTBText "ObjTitleBlock_Text_Backface" , catBottomLeft , 5
For i=1 To (ObjAmount)
Set Text = DrwTexts.Add(TextO_01, OH + Coll(1) + 3. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_02, OH + Coll(2) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_03, OH + Coll(3) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_04, OH + Coll(4) + 3. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_05, OH + Coll(5) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_06, OH + Coll(6) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_07, OH + Coll(7) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft , 5
Set Text = DrwTexts.Add(TextO_08, OH + Coll(8) + 2. , OV + (Rowl(i+2)+1) )
CATFormatTBText "ObjTitleBlock_TextO_coll_"&i , catBottomLeft ,
5
Next
CATLinks
End Sub
Sub CATFormatFText(textName As String, angle As Double)
'-------------------------------------------------------------------------------
'How to format the texts belonging to the frame
'-------------------------------------------------------------------------------
https://www.doczj.com/doc/698597123.html, = textName
Text.AnchorPosition = CATMiddleCenter
Text.Angle = angle
End Sub
' CATFormatFText()
Sub CATFormatTBText(textName As String, anchorPosition As String, fontSize)
'-------------------------------------------------------------------------------
'How to format the texts belonging to the titleblock
'-------------------------------------------------------------------------------
https://www.doczj.com/doc/698597123.html, = textName
'Text.SetFontName 0, 0, "TTFangSong_GB2312(TrueType)"
Text.SetFontName 0, 0, "SICH"
Text.AnchorPosition = anchorPosition
Text.SetFontSize 0, 0, fontSize
' 修改字符串字体的Spacing
Dim iParamCharSpace as CatTextProperty
iParamCharSpace = catCharSpacing
Text.SetParameterOnSubString iParamCharSpace, 0, 0, CharSpacing
' 修改字符串字体的Ratio
Dim iParamRatio as CatTextProperty
iParamRatio = catCharRatio
Text.SetParameterOnSubString iParamRatio, 0, 0, CharRatio
End Sub
' CATFormatTBText()
Sub CATLinks()
'-------------------------------------------------------------------------------
'How to fill in texts with data of the part/product linked with current sheet
'-------------------------------------------------------------------------------
On Error Resume Next
Dim ProductDrawn As ProductDocument
Set ProductDrawn = DrwSheet.Views.Item("Front view").GenerativeBehavior.Document
If Err.Number = 0 Then
DrwTexts.GetItem("TitleBlock_Text_Number_1").Text = ProductDrawn.PartNumber
DrwTexts.GetItem("TitleBlock_Text_Title_1").Text = ProductDrawn.Definition
Dim ProductAnalysis As Analyze
Set ProductAnalysis = ProductDrawn.Analyze
DrwTexts.GetItem("TitleBlock_Text_Weight_1").Text = FormatNumber(ProductAnalysis.Mass,2)
End If
'-------------------------------------------------------------------------------
'Display sheet format
'-------------------------------------------------------------------------------
Dim textFormat As DrawingText
Set textFormat = DrwTexts.GetItem("Text_23")
textFormat.Text = displayFormat
If (Len(displayFormat) > 4 ) Then
textFormat.SetFontSize 0, 0, 2.5
Else
textFormat.SetFontSize 0, 0, 4.
End If
'-------------------------------------------------------------------------------
'Display sheet numbering
'-------------------------------------------------------------------------------
Dim nbSheet As Integer
Dim curSheet As Integer
nbSheet = 0
curSheet = 0
If (Not DrwSheet.IsDetail) Then
For i = 1 To DrwSheets.Count
If (Not DrwSheets.Item(i).IsDetail) Then
nbSheet = nbSheet + 1
End If
Next
For i = 1 To DrwSheets.
Count
If (Not DrwSheets.Item(i).IsDetail) Then
On Error Resume Next
curSheet = curSheet + 1
DrwSheets.Item(i).Views.Item(2).Texts.GetItem("TitleBlock_Text_Sheet_1").Text = CStr(curSheet) & "/" & CStr(nbSheet)
End If
Next
End If
On Error GoTo 0
End Sub
' CATLinks()
Sub ChgLineThickness(ByRef aLine as CATIALine2D, _
ByVal aThickness as Double)
Dim osel as Selection
Dim ovisProps as VisProperies
set osel = DrwDocument.Selection
osel.Clear
osel.Add aLine
set ovisProps = osel.VisProperties
ovisProps.SetRealWidth aThickness, 1
'ovisProps.SetRealWidth 1,1
set ovisProps = Nothing
set osel = Nothing
End Sub
' ChgLineThickness()
' 设置标题栏手工输入字符串的字符格式
Sub CATFormatTBTextHw(aTextName as String, _
anchorPosition as String, _
afontSize)
https://www.doczj.com/doc/698597123.html, = aTextName
Text.SetFontName 0, 0, "SICH"
Text.AnchorPosition = anchorPosition
Text.SetFontSize 0, 0, afontSize
' 修改字符串字体的Spacing值
Dim iParamCharSpace as CatTextProperty
iParamCharSpace = catCharSpacing
Text.SetParameterOnSubString iParamCharSpace, 0, 0, 20
End Sub