CATIA百格线
=================从这里开始不要复制我===========================
Option Explicit
' *********************************************************************** ' Purpose: This macro allows you to create Grid line in CATIA drawing
' Languages: VBScript
' Locales: English
' Developing CATIA Level: V5R14-R17
' View mush parallel to system aixes,view angle 0deg,90deg and -90deg
' *********************************************************************** Sub CATMain()
CATIA.RefreshDisplay = False
' Set the CATIA popup file alerts to False
' It prevents to stop the macro at each alert during its execution
CATIA.DisplayFileAlerts = False
' Optional: allows to find the sample wherever it's installed
' Variables declaration
Dim oDrwDocument As DrawingDocument
Dim oDrwSheets As DrawingSheets
Dim oDrwSheet As DrawingSheet
Dim oDrwView As DrawingView
Dim oFactory2D AS Factory2D
' The Distance between the lines
Dim D As Integer
Dim nx As Integer
Dim ny As Integer
' The point coordinate select from Drawing
Dim X1 As Integer
Dim Y1 As Integer
Dim X2 As Integer
Dim Y2 As Integer
Dim Pt1 As Point2D
Dim Pt2 As Point2D
'The view scale dAngle for rotate view scale for view scale
Dim dAngle As Double
'==================================
'读取间隔距离
'==================================
D= InputBox("请输入坐标距离，100的整数倍", "input box", "1")
D= Cint (D)
if D<1 then D=0
D=D*100
'==================================
'初始参数赋值
'==================================
' Retrive a new drawing document
Set oDrwDocument = CATIA.ActiveDocument
' Retrieve the drawing document's sheets collection
Set oDrwSheets = oDrwDocument.Sheets
' Retrieve the active sheet
Set oDrwSheet = oDrwSheets.ActiveSheet
' Retrieve the active view of the sheet
Set oDrwView = oDrwSheet.Views.ActiveView
'Retrive the value of the view
dAngle= oDrwView.Angle
Set oFactory2D = oDrwView.Factory2D
'Get the coordinate from the select two point
'On Error Resume Next
'=================================
'选取对角线上两点
'=================================
Dim pt1Coord(1),pt2Coord(1),pt0Coord(1)
Dim WindowLocation(1),Status
Status=CATIA.ActiveDocument.Indicate2D("请选择对角线第一点",WindowLocation) if(Status = "Cancel" Or Status = "Undo" Or Status = "Redo") then Exit Sub
pt1Coord(0)=WindowLocation(0):pt1Coord(1)=WindowLocation(1)
Status=CATIA.ActiveDocument.Indicate2D("请选择对角线第二点",WindowLocation) if(Status = "Cancel" Or Status = "Undo" Or Status = "Redo") then Exit Sub
pt2Coord(0)=WindowLocation(0):pt2Coord(1)=WindowLocation(1)
'=================================
'坐标变换
'=================================
if pt1Coord(0)>pt2Coord(0) then
pt0Coord(0)=pt1Coord(0)
pt1Coord(0)=pt2Coord(0)
pt2Coord(0)=pt0Coord(0)
end if
if pt1Coord(1)>pt2Coord(1) then
pt0Coord(1)=pt1Coord(1)
pt1Coord(1)=pt2Coord(1)
pt2Coord(1)=pt0Coord(1)
end if
'==============================
'网格线计算
'==============================
if dAngle=0 then
X1= Cint (pt1Coord(0))
Y1= Cint (pt1Coord(1))
X2= Cint (pt2Coord(0))
Y2= Cint (pt2Coord(1))
end if
X1 = D * Cint (X1/D)
Y1 = D * Cint (Y1/D)
X2= D * Cint (X2/D)
Y2 = D * Cint (Y2/D)
nx = (X2-X1) \ D 'The number of the horizontal line
ny = (Y2-Y1) \ D 'The number of the vertical line
Dim Line2D1 As Line2D
Dim Circle2D1 as Circle2D
Dim MyText as DrawingText
Dim iFontSize as Double
Dim iFontName as String
Dim i As Int
Dim j As Int
Dim R As Doubel 'the radius of the circle
iFontSize = 7
iFontName ="SICH"
'------------------------------------------------------
Dim Di_H,Di_V as int
Dim Text_XYZ_H as string
Dim Text_XYZ_V as string
Di_H=1
Di_V=1
'Compare the drawing view HV with 3D Aixes
Dim XX1,YY1,ZZ1,XX2,YY2,ZZ2 as int
oDrwView.GenerativeBehavior.GetProjectionPlane XX1,YY1,ZZ1,XX2,YY2,ZZ2
if (XX1=1) then
Text_XYZ_H="X"
End if
if (XX1=-1) then
Text_XYZ_H="X"
Di_H=-1
End if
if (YY1=1) then
Text_XYZ_H="Y"
End if
if (YY1=-1) then
Text_XYZ_H="Y"
Di_H=-1
End if
if (ZZ1=1) then
Text_XYZ_H="Z"
End if
if (ZZ1=-1) then
Text_XYZ_H="Z"
Di_H=-1
End if
if (XX2=1) then
Text_XYZ_V="X"
End if
if (XX2=-1) then
Text_XYZ_V="X"
Di_V=-1
End if
if (YY2=1) then
Text_XYZ_V="Y"
End if
if (YY2=-1) then
Text_XYZ_V="Y"
Di_V=-1
End if
if (ZZ2=1) then
Text_XYZ_V="Z"
End if
if (ZZ2=-1) then
Text_XYZ_V="Z"
Di_V=-1
End if
if dAngle>0 then
Di_V=-Di_V
end if
if dAngle<0 then
Di_H=-Di_H
end if
Dim oSel as Selection
Dim oVisProps as VisPropertySet
set oSel = oDrwDocument.Selection
oSel.Clear
set oVisProps = oSel.VisProperties
'Dim TextV As int
'TextV=R/2
'Draw the horizontall line
for i=0 TO ny
if dAngle=0 then
set Line2D1 = oFactory2D.CreateLine (X1-D/8,Y1+D*i,X1+nx*D+D/8,Y1+D*i)
oSel.Add Line2D1
'set Circle2D1=oFactory2D.CreateClosedCircle(X1-D/3 -R,Y1+D*i,R)
' oSel.Add Circle2D1
' set Line2D1= oFactory2D.CreateLine(X1-D/3-R*2,Y1+D*i,X1-D/3,Y1+D*i)
' oSel.Add Line2D1
'Set MyText = oDrwView.Texts.Add(Text_XYZ_V,X1-D/3 -R,Y1+D*i+TextV)
'MyText.AnchorPosition = catMiddleCenter
'MyText.SetFontSize 0, 0, iFontSize
'MyText.SetFontName 0,0,iFontName
'oSel.Add MyText
Set MyText = oDrwView.Texts.Add((Y1+D*i)*Di_V/100&Text_XYZ_V,X1-D/8 -2,Y1+D*i)
MyText.AnchorPosition = catMiddleRight
MyText.SetFontSize 0, 0, iFontSize
MyText.SetFontName 0,0,iFontName
oSel.Add MyText
end if
next
'Draw the vertical line
for j=0 TO nx
if dAngle=0 then
set Line2D1 = oFactory2D.CreateLine (X1+D*j,Y1-D/8,X1+D*j,Y1+ny*D+D/8)
oSel.Add Line2D1
Set MyText = oDrwView.Texts.Add((X1+D*j)*Di_H/100&Text_XYZ_H,X1+D*j,y1+ny*D+D/8+2)
MyText.AnchorPosition = catBottomCenter
MyText.SetFontSize 0, 0, iFontSize
MyText.SetFontName 0,0,iFontName
oSel.Add MyText
end if
next
oVisProps.SetRealWidth 1,0 '1st parameter line width 1-63 2nd parameter inheritance flag 1 or 0
oVisProps.SetRealColor 4,155,88,1
oSel.Clear
oSel.Clear
Set oVisProps = Nothing
Set oSel = Nothing
' Update drawing table modifications
CATIA.ActiveWindow.ActiveViewer.Reframe
End Sub
======================从这里结束不要复制我===================================
以文本形式保存文档，然后将后缀名改为CATScript就可以使用了
使用方法：
如何利用Draw-Grid快速绘制百格线
操作方法如下：
1、激活需要添加百格线的视图，如下图操作：（双击视图的蓝色边框,或在视图的蓝色边框
上右击鼠标,在弹出菜单中选择“Activate View”）
2、按Alt+F8，或者在菜单Tool-Macro中选择macros，出现如下对话框
3、在上图菜单中点击“select”，选择Draw-Grid文件，再点击“Run”，出现如下界面，输入百
格线的坐标距离。按QC/T 490车身制图标准，百格线可以是50mm、100mm或者200mm。
一般我们采用默认的100mm即可。故这里可以使用默认值1。
4、在视图点击对角线的第一点、第二点，具体根据零件的尺寸而定。
5、坐标线即可以自动绘制完毕。如下图。