用CATScript 做的CATIA标题栏和工程图框（转贴）
使用方法：drafting--〉edit--〉background--〉tools--〉macro--〉macros中select本文件，run即可。环境变量设置（很实用）
CATLM_ODTS=1 - Disable license error messages at startup
L_WILSON_LAN=1 - Access to Wilson's spline curves
CGM_ROLLINGOFFSET=1 - Access to the Rolling Offset option in GSD
TAILLE_MEMOIRE_CHOISIE=1 - Optimize IGES export memory
CATNoStartDocument=no - Disable product at startup
CNEXTBACKGROUND = no - Disable sky background at startup
CNEXTSPLASHSCREEN = no - Disable display of planet at startup
SHOW_CST_CHILDREN = 1 - Display stresses in the parents specification tree in sketcher
CNEXTOUTPUT = console - Display Catia's logs in command windows
MM_NO_REPLACE = 1 - Associativty about replacement of components cloned with different 标题栏.CATScript
'COPYRIGHT DASSAULT SYSTEMES 2001
' ****************************************************************************
' Purpose: To draw a Frame and TitleBlock
' Assumptions: A Drafting document should be active
' Author: 庞军杰，王晓军
' Languages: VBScript
' Version: V5R7
' ****************************************************************************
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 Cicle 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(16) As Double 'Columns coordinates
Public Row(6) As Double 'Rows coordinates
Public colRev(4) As double 'Columns coordinates of revision block
Public TranslationXAs Double 'Horizontal translation to operate when changing standard
Public TranslationYAs 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
PublicObjAmountAs Double
Public Coll(8) As Double 'Collumns coordinates
Public Rowl(53) As Double 'Rowls coordinatesObjAmount=i+3
'end
Const mm = 1
Const Inch = 254
Const RulerLength= 200
Const MacroID = "Drawing_Titleblock_JUNJIE"
Const RevRowHeight = 10
Sub CATMain()
CATInit
On Error Resume Next
name = DrwTexts.GetItem("Reference_" + 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>0Then
' CATTitleObjBlock'To draw the TitleBlock and fill in it
' ElseExit 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
End Sub
Sub CATStandard()
'-------------------------------------------------------------------------------
'How to compute standard values
'-------------------------------------------------------------------------------
Height = DrwSheet.GetPaperHeight
Width = DrwSheet.GetPaperWidth
sheetFormat = DrwSheet.PaperSize
Offset = 10.*mm 'Offset default value = 10.
If (sheetFormat = CatPaperA0 Or sheetFormat = CatPaperA1 Or sheetFormat = CatPaperUser And _
(DrwSheet.GetPaperWidth > 594.*mm Or DrwSheet.GetPaperHeight > 594.*mm)) Then
Offset = 20.*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)
Text.Name = "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<nbTexts)
i = i + 1
Set Text = DrwTexts.Item(i)
WholeName = Text.Name
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 (Text.Name <> 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, 841are 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 RulerLength < Ruler Then
Ruler = RulerLength
End If
End Sub
Sub CATFrameBorder()
'-------------------------------------------------------------------------------
'How to draw the frame border
'-------------------------------------------------------------------------------
On Error Resume Next
Set Line = Fact.CreateLine(OV, OV , OH, OV )
Line.Name = "Frame_Border_Bottom"
Set Line = Fact.CreateLine(OH, OV , OH, Height - Offset)
Line.Name = "Frame_Border_Left"
Set Line = Fact.CreateLine(OH, Height - Offset, OV, Height - Offset)
Line.Name = "Frame_Border_Top"
Set Line = Fact.CreateLine(OV, Height - Offset, OV, OV )
Line.Name = "Frame_Border_Right"
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>0Then
CATTitleObjBlock'To draw the TitleObjBlock and fill in it
ElseExit 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” →带有明细栏的装配图标题栏" )
If( ObjAmount<2and ObjAmount>101 )then
ObjAmount= InputBox("请输入零件的数目(不大于101不小于2。)：" )
End If
RowWidth = + 7*mm 'Define rowsRowwidth.
const Rows = 7 'Define how many rows .
Col(1)= -180*mm
Col(2)= -170*mm
Col(3)= -168*mm
Col(4)= -160*mm
Col(5)= -156*mm
Col(6)= -146*mm
Col(7)= -140*mm
Col(8)= -128*mm
Col(9)= -116*mm
Col(10) = -100*mm
Col(11) = -93.5*mm
Col(12) = -87*mm
Col(13) = -80.5*mm
Col(14) = -74*mm
Col(15) = -62*mm
Col(16) = -50*mm
Row(1) = +9*mm
Row(2) = + 18*mm
Row(3) = + 28*mm
Row(4) = + 42*mm
Row(5) = + 56*mm
Row(6) = + 38*mm 'revised
On Error Resume Next
'Rows
Set Line = Fact.CreateLine(OH + Col(1), OV , OH , OV )
Line.Name = "TitleBlock_Line_Bottom"
Set Line = Fact.CreateLine(OH + Col(1), OV + Row(5), OH , OV + Row(5))
Line.Name = "TitleBlock_Line_Top"
Set Line = Fact.CreateLine(OH +Col(10),OV + Row(1) , OH +Col(16) , OV + Row(1))
Line.Name = "TitleBlock_Line_Row_1"
Set Line = Fact.CreateLine(OH +Col(10), OV + Row(2), OH , OV + Row(2))
Line.Name = "TitleBlock_Line_Row_2"
Set Line = Fact.CreateLine(OH +Col(10), OV + Row(3), OH+Col(16) , OV + Row(3))
Line.Name = "TitleBlock_Line_Row_3"
Set Line = Fact.CreateLine(OH + Col(16), OV + Row(6), OH , OV + Row(6))
Line.Name = "TitleBlock_Line_Row_4"
For i=1 toRows
Set Line = Fact.CreateLine(OH + Col(1), OV + (7*i), OH+ Col(10), OV + (7*i))
Line.Name = "TitleBlock_Line_LeftRow_"&i
Next
'Cols
Set Line = Fact.CreateLine(OH + Col(1), OV , OH + Col(1), OV + Row(5))
Line.Name = "TitleBlock_Line_Left"
Set Line = Fact.CreateLine(OH , OV , OH , OV + Row(5))
Line.Name = "TitleBlock_Line_Right"
Set Line = Fact.CreateLine(OH + Col(2), OV+ Row(3) , OH + Col(2), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_1"
Set Line = Fact.CreateLine(OH + Col(3), OV , OH + Col(3), OV + Row(3))
Line.Name = "TitleBlock_Line_Column_2"
Set Line = Fact.CreateLine(OH + Col(4), OV+ Row(3) , OH + Col(4), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_3"
Set Line = Fact.CreateLine(OH + Col(5), OV , OH + Col(5), OV + Row(3))
Line.Name = "TitleBlock_Line_Column_4"
Set Line = Fact.CreateLine(OH + Col(6), OV+ Row(3) , OH + Col(6), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_5"
Set Line = Fact.CreateLine(OH + Col(7), OV , OH + Col(7), OV + Row(3))
Line.Name = "TitleBlock_Line_Column_6"
Set Line = Fact.CreateLine(OH + Col(8), OV , OH + Col(8), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_7"
Set Line = Fact.CreateLine(OH + Col(9), OV , OH + Col(9), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_8"
Set Line = Fact.CreateLine(OH +Col(10), OV , OH +Col(10), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_9"
Set Line = Fact.CreateLine(OH + Col(11), OV+ Row(1), OH + Col(11), OV + Row(2))
Line.Name = "TitleBlock_Line_Column_10"
Set Line = Fact.CreateLine(OH + Col(12), OV+ Row(1), OH + Col(12), OV + Row(2))
Line.Name = "TitleBlock_Line_Column_11"
Set Line = Fact.CreateLine(OH + Col(13), OV+ Row(1), OH + Col(13), OV + Row(2))
Line.Name = "TitleBlock_Line_Column_12"
Set Line = Fact.CreateLine(OH + Col(14), OV+ Row(1), OH + Col(14), OV + Row(3))
Line.Name = "TitleBlock_Line_Column_13"
Set Line = Fact.CreateLine(OH + Col(15), OV+ Row(1), OH + Col(15), OV + Row(3))
Line.Name = "TitleBlock_Line_Column_14"
Set Line = Fact.CreateLine(OH + Col(16), OV , OH + Col(16), OV + Row(5))
Line.Name = "TitleBlock_Line_Column_15"
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-down subBlock.
Text_01= "指导教师"
Text_02= "审核"
Text_03= "设计"
Text_04= "张国建"
Text_05= "03.09.25"
Text_06= "标准化"
Text_07= "(签名)"
Text_08= "(年月日)"
Text_09= "批准"
Text_001= " "
'The Left-up subBlock.
Text_10= "标记"
Text_11= "处数"
Text_12= "分区"
Text_13= "更改文件号"
Text_14= "(签名)"
Text_15= "(年月日)"
'The Middle subblock
Text_16 = " 共张 第张 "
Text_17 = "比例"
Text_18 = "重量"
Text_19= " 阶 段 标 记"
Text_20 = "(材料标记)"
'The right subblock
Text_21 = "上海方宇工业设计"
Text_22 ="(图样名称)"
Text_23 = "课程设计专用图纸"
'The Left-down subBlockText.
Set Text = DrwTexts.Add(Text_01 , OH + Col(1) , OV+1 )
CATFormatTBText "TitleBlock_Text_Techer" ,catBottomLeft, 4
Set Text = DrwTexts.Add(" ", OH + Col(3) , OV+1 )
CATFormatTBText "TitleBlock_Text_Tec_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(5) + 3. , OV+1 )
CATFormatTBText "TitleBlock_Text_Tec_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_02 ,OH + Col(1)+2 , OV + Rowwidth )
CATFormatTBText "TitleBlock_Text_checker" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(3) + 1. , OV + Rowwidth )
CATFormatTBText "TitleBlock_Text_chec_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(5) + 1. , OV + Rowwidth )
CATFormatTBText "TitleBlock_Text_chec_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_03 , OH + Col(1) + 2. , OV + (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_design" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " , OH + Col(1) + 1. , OV + (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_des_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_04 , OH + Col(3) + 1. , OV+ (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_Sign " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(3) + 1. , OV+ (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_Sign_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_05 , OH + Col(5) + 1. , OV+ (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_Date " ,catBottomLeft, 4
Set Text = DrwTexts.Add(" ", OH + Col(5) + 1. , OV+ (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_Date_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_06 , OH + Col(7) + 1. , OV + (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_Standard" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(7) + 1. , OV + (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_Std_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(7) + 1. , OV+ (Rowwidth*1) )
CATFormatTBText "TitleBlock_Text_Std_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_07 , OH + Col(8) + 1. , OV+ (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_Sign2 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV+ (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_Sign2_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV+ (Rowwidth*1) )
CATFormatTBText "TitleBlock_Text_Sign2_2 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_08 , OH + Col(9) + 1. , OV+ (Rowwidth*3) )
CATFormatTBText "TitleBlock_Text_Date2 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV+ (Rowwidth*2) )
CATFormatTBText "TitleBlock_Text_Date2_1 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV+ (Rowwidth*1) )
CATFormatTBText "TitleBlock_Text_Date2_2 " ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_09 , OH + Col(7) + 3. , OV )
CATFormatTBText "TitleBlock_Text_Allow" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV )
CATFormatTBText "TitleBlock_Text_Allow_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV )
CATFormatTBText "TitleBlock_Text_Allow_2" ,catBottomLeft, 5
'The Left-up subBlockText.
Set Text = DrwTexts.Add(Text_10 , OH + Col(1) + 1. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_Mark" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(1) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_Mark_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(1) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_Mark_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(1) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_Mark_3" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_11 , OH + Col(2) + 1. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_Amout" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(2) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_Amout_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(2) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_Amout_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(2) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_Amout_3" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_12 , OH + Col(4) +3. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_District" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(4) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_Dis_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(4) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_Dis_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(4) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_Dis_3" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_13 , OH + Col(6) + 1. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_ReviseList" ,catBottomLeft,5
Set Text = DrwTexts.Add(" ", OH + Col(6) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_RevL_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(6) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_RevL_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(6) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_RevL_3" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_14 , OH + Col(8) + 1. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_SignL" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_SignL_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_SignL_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(8) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_SignL_3" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_15 , OH + Col(9) + 1. , OV+ (Rowwidth*4) )
CATFormatTBText "TitleBlock_Text_DateL" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV+ (Rowwidth*5) )
CATFormatTBText "TitleBlock_Text_DateL_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV+ (Rowwidth*6) )
CATFormatTBText "TitleBlock_Text_DateL_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(9) + 1. , OV+ (Rowwidth*7) )
CATFormatTBText "TitleBlock_Text_DateL_3" ,catBottomLeft, 5
'The Middle subblockText.
Set Text = DrwTexts.Add(Text_16, OH + Col(10) + 1. , OV )
CATFormatTBText "TitleBlock_Text_Acount" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " , OH + Col(12) -5. , OV )
CATFormatTBText "TitleBlock_Text_Acount_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " , OH + Col(15) + 1. , OV )
CATFormatTBText "TitleBlock_Text_Acount_2" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_17,OH + Col(15) + 2. , OV +(Row(2)+3) )
CATFormatTBText "TitleBlock_Text_Scale" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " ,OH + Col(15) , OV+(Row(1)+3) )
CATFormatTBText "TitleBlock_Text_Scale_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_18 , OH + Col(14) + 2. , OV +(Row(2)+3) )
CATFormatTBText "TitleBlock_Text_Weight" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " , OH + Col(14) + 2. , OV+(Row(1)+3) )
CATFormatTBText "TitleBlock_Text_Weight_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_19 ,OH + Col(10) + 1. , OV +(Row(2)+3) )
CATFormatTBText "TitleBlock_Text_PhaseSign" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" " , OH + Col(10) + 1. , OV+(Row(1)+2) )
CATFormatTBText "TitleBlock_Text_Phs_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(11) + 1. , OV+(Row(1)+2) )
CATFormatTBText "TitleBlock_Text_Phs_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(12) + 1. , OV+(Row(1)+2) )
CATFormatTBText "TitleBlock_Text_Phs_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(" ", OH + Col(13) + 1. , OV+(Row(1)+2) )
CATFormatTBText "TitleBlock_Text_Phs_1" ,catBottomLeft, 5
Set Text = DrwTexts.Add(Text_20 , OH + Col(10) + 25. , OV +(Row(3)+5) )
CATFormatTBText "TitleBlock_Text_MaterialSign" ,catBottomCenter, 10
'The right subblockText.
Set Text = DrwTexts.Add(Text_21, OH + Col(16) +25. , OV +Row(4) )
CATFormatTBText "TitleBlock_Text_School" ,catBottomCenter, 7
Set Text = DrwTexts.Add(Text_22, OH + Col(16) +25. , OV +(Row(2)+5) )
CATFormatTBText "TitleBlock_Text_DrawingName" ,catBottomCenter, 7
Set Text = DrwTexts.Add(Text_23, OH + Col(16) +25. , OV +5 )
CATFormatTBText "TitleBlock_Text_Use" ,catBottomCenter, 7
End Sub Sub CATTitleObjBlockFrame()
'-------------------------------------------------------------------------------
'How to draw the title Objblock geometry
'-------------------------------------------------------------------------------
Coll(1) = -180*mm
Coll(2) = -172*mm
Coll(3) = -134*mm
Coll(4) = -90*mm
Coll(5) = - 82*mm
Coll(6) = - 44*mm
Coll(7) = - 34*mm
Coll(8) = - 24*mm
Rowl(1) = + 56*mm
Rowl(2) = + 63*mm
Rowl(3) = + 70*mm
For i=1 toObjAmount
Rowl(i+3)= + (70+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))
Line.Name = "TitleObjBlock_Shotest_Bottom"
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(3) , OH , OV + Rowl(3))
Line.Name = "TitleObjBlock_RowlLine_Bottom"
For i=1 to ObjAmount
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(i+3) , OH , OV + Rowl(i+3))
Line.Name = "TitleObjBlock_RowlLine_No." & i
DrawingDimLine.thickness=1
Next
'creat TitleObjBlock CollLines .
Set Line = Fact.CreateLine(OH + Coll(8), OV +Rowl(1) , OH+ Coll(8) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.8"
Set Line = Fact.CreateLine(OH + Coll(7), OV +Rowl(2) , OH+ Coll(7) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.7"
Set Line = Fact.CreateLine(OH + Coll(6), OV +Rowl(1) , OH+ Coll(6) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.6"
Set Line = Fact.CreateLine(OH + Coll(5), OV +Rowl(1) , OH+ Coll(5) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.5"
Set Line = Fact.CreateLine(OH + Coll(4), OV +Rowl(1) , OH+ Coll(4) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.4"
Set Line = Fact.CreateLine(OH + Coll(3), OV +Rowl(1) , OH+ Coll(3) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.3"
Set Line = Fact.CreateLine(OH + Coll(2), OV +Rowl(1) , OH+ Coll(2) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.2"
Set Line = Fact.CreateLine(OH + Coll(1), OV +Rowl(1) , OH+ Coll(1) , OV + Rowl( ObjAmount+3))
Line.Name = "TitleObjBlock_Collline_No.1"
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) +"重量(Kg)"
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) + 4. , OV + (Rowl(2)+3) )
CATFormatTBText "ObjTitleBlock_Text_xu" ,catMiddleCenter, 5
Set Text = DrwTexts.Add(Text_02, OH + Coll(1) + 4. , OV + (Rowl(1)+3) )
CATFormatTBText "ObjTitleBlock_Text_hao" ,catMiddleCenter, 5
Set Text = DrwTexts.Add(Text_03, OH + Coll(2) + 4. , OV + (Rowl(1)+3) )
CATFormatTBText "ObjTitleBlock_Text_Cname" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_04, OH + Coll(3) + 4. , OV + (Rowl(1)+3) )
CATFormatTBText "ObjTitleBlock_Text_Name" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_05, OH + Coll(4) + 4. , OV + (Rowl(2)+3) )
CATFormatTBText "ObjTitleBlock_Text_shu" ,catMiddleCenter, 5
Set Text = DrwTexts.Add(Text_06, OH + Coll(4) + 4. , OV + (Rowl(1)+3) )
CATFormatTBText "ObjTitleBlock_Text_liang" ,catMiddleCenter, 5
Set Text = DrwTexts.Add(Text_07, OH + Coll(5) + 1. , OV + (Rowl(1)+3) )
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 , 5
Set Text = DrwTexts.Add(Text_09, OH + Coll(7) + 2. , OV + (Rowl(2)+1) )
CATFormatTBText "ObjTitleBlock_Text_Amount" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_10, OH + Coll(6) + 3. , OV + (Rowl(1)+1) )
CATFormatTBText "ObjTitleBlock_Text_weigt" , catBottomLeft , 5
Set Text = DrwTexts.Add(Text_11, OH + Coll(8) + 1. , OV + (Rowl(1)+3) )
CATFormatTBText "ObjTitleBlock_Text_Backface" , catBottomLeft , 5
For i=1 to(ObjAmount)
Set Text = DrwTexts.Add(TextO_01, OH + Coll(1) + 2. , 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) + 1. , 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
'-------------------------------------------------------------------------------
Text.Name = textName
Text.AnchorPosition = CATMiddleCenter
Text.Angle = angle
End Sub
Sub CATFormatTBText(textName As String, anchorPosition As String, fontSize)
'-------------------------------------------------------------------------------
'How to format the texts belonging to the titleblock
'-------------------------------------------------------------------------------
Text.Name = textName
Text.SetFontName 0, 0, "FangSong_GB2312"
Text.AnchorPosition = anchorPosition
Text.SetFontSize 0, 0, fontSize
End Sub
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 nbSheetAs 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 楼主：
您好！
按你提供的方法创建的标题栏的所有线型均是粗实线
有没有办法选择性生成“细实线”呀
页:
[1]