二位图坐标线自动生成程序使用指南.docx
- 文档编号:9433996
- 上传时间:2023-02-04
- 格式:DOCX
- 页数:15
- 大小:93.81KB
二位图坐标线自动生成程序使用指南.docx
《二位图坐标线自动生成程序使用指南.docx》由会员分享,可在线阅读,更多相关《二位图坐标线自动生成程序使用指南.docx(15页珍藏版)》请在冰豆网上搜索。
二位图坐标线自动生成程序使用指南
/*使用方法*/
Alt+F8弹出
'
点
创建微程序目录
点击
选择指定路径(在这里选择D盘作为路径)
点
回到
原始界面,
点击
按钮,弹出下面界面,这时候必须选中CATScript
单击
按钮回到macros原始界面
点击
弹出
把以下程序断粘贴进去即可。
进入二维图界面后,做两点(将来形成的网格线就在这两个点范围内)
Alt+F8出现
界面,点击
后,分别选择两点后,网格将自动生成!
!
!
!
OptionExplicit
***********************************************************************
'Purpose:
ThismacroallowsyoutocreateGridlineinCATIAdrawing
'Author:
chenqa
'Languages:
VBScript
'Locales:
English
'DevelopingCATIALevel:
V5R12
'Viewmushparalleltosystemaixes,viewangle0deg,90degand-90deg
'***********************************************************************
SubCATMain()
CATIA.RefreshDisplay=False
DimsStatusAsString
'SettheCATIApopupfilealertstoFalse
'Itpreventstostopthemacroateachalertduringitsexecution
CATIA.DisplayFileAlerts=False
'Optional:
allowstofindthesamplewhereverit'sinstalled
'Variablesdeclaration
DimoDrwDocumentAsDrawingDocument
DimoDrwSheetsAsDrawingSheets
DimoDrwSheetAsDrawingSheet
DimoDrwViewAsDrawingView
DimoFactory2DASFactory2D
'TheDistancebetweenthelines
DimDAsInteger
DimnxAsInteger
DimnyAsInteger
'ThepointcoordinateselectfromDrawing
DimX1AsInteger
DimY1AsInteger
DimX2AsInteger
DimY2AsInteger
DimPt1AsPoint2D
DimPt2AsPoint2D
'TheviewscaledAngleforrotateviewscaleforviewscale
DimdScale,dAngleAsDouble
'Theviewcoordinateorigin
DimXAsInt
DimYAsInt
DimxSelAsINFITF.Selection
D=InputBox("PleaseInputtheDistanceValue","inputbox","100")
D=Cint(D)
'Retriveanewdrawingdocument
SetoDrwDocument=CATIA.ActiveDocument
'Retrievethedrawingdocument'ssheetscollection
SetoDrwSheets=oDrwDocument.Sheets
'Retrievetheactivesheet
SetoDrwSheet=oDrwSheets.ActiveSheet
'Retrievetheactiveviewofthesheet
SetoDrwView=oDrwSheet.Views.ActiveView
'Retrivethevalueoftheview
X=oDrwView.xAxisData
Y=oDrwView.yAxisData
dScale=oDrwView.Scale
dAngle=oDrwView.Angle
SetoFactory2D=oDrwView.Factory2D
'Getthecoordinatefromtheselecttwopoint
'OnErrorResumeNext
SetxSel=CATIA.ActiveDocument.Selection
xSel.clear
ReDimsFilter(0)
sFilter(0)="Point2D"
MsgBox"Pleaseselecttheleft-bottompoint"
sStatus=xSel.SelectElement(sFilter,"SelectFirstPoint.",false)
If(sStatus="Normal")Then
DimSelectedPoint1AsSelectedElement
SetSelectedPoint1=xSel.Item
(1)
Dimpt1Coord
(2)AsInt
SelectedPoint1.GetCoordinates(pt1Coord)
'MsgBox"Thefrstpointhasbeenselected"
ElseMsgBox"Selecta2DPoint1"
ExitSub
EndIf
MsgBox"Pleaseselecttheritht-toppoint"
sStatus=xSel.SelectElement(sFilter,"SelectTheSecondPoint.",false)
If(sStatus="Normal")Then
DimSelectedPoint2AsSelectedElement
SetSelectedPoint2=xSel.Item
(1)
Dimpt2Coord
(2)AsInt
SelectedPoint2.GetCoordinates(pt2Coord)
'MsgBox"Thesecondpointhasbeenselected"
ElseMsgBox"Selecta2DPoint1"
ExitSub
EndIf
ifdAngle=0then
X1=Cint((pt1Coord(0)-X)/dScale)
Y1=Cint((pt1Coord
(1)-Y)/dScale)
X2=Cint((pt2Coord(0)-X)/dScale)
Y2=Cint((pt2Coord
(1)-Y)/dScale)
endif
'MsgBox(pt1Coord(0))
'MsgBoxX
ifdAngle>0then
X1=Cint((pt1Coord
(1)-Y)/dScale)
Y1=Cint((pt1Coord(0)-X)/dScale)
X2=Cint((pt2Coord
(1)-Y)/dScale)
Y2=Cint((pt2Coord(0)-X)/dScale)
endif
ifdAngle<0then
X1=Cint((pt1Coord
(1)-Y)/dScale)
Y1=Cint((pt1Coord(0)-X)/dScale)
X2=Cint((pt2Coord
(1)-Y)/dScale)
Y2=Cint((pt2Coord(0)-X)/dScale)
endif
X1=D*Cint(X1/D)
Y1=D*Cint(Y1/D)
X2=D*Cint(X2/D)
Y2=D*Cint(Y2/D)
nx=(X2-X1)\D'Thenumberofthehorizontalline
ny=(Y2-Y1)\D'Thenumberoftheverticalline
DimLine2D1AsLine2D
DimCircle2D1asCircle2D
DimMyTextasDrawingText
DimiFontsizeasDouble
DimiAsInt
DimjAsInt
DimRAsDoubel'theradiusofthecircle
iFontSize=3.5
R=5
R=R/dScale
'------------------------------------------------------
DimDi_H,Di_Vasint
DimText_XYZ_Hasstring
DimText_XYZ_Vasstring
Di_H=1
Di_V=1
'ComparethedrawingviewHVwith3DAixes
DimXX1,YY1,ZZ1,XX2,YY2,ZZ2asint
oDrwView.GenerativeBehavior.GetProjectionPlaneXX1,YY1,ZZ1,XX2,YY2,ZZ2
if(XX1=1)then
Text_XYZ_H="X"
Endif
if(XX1=-1)then
Text_XYZ_H="X"
Di_H=-1
Endif
if(YY1=1)then
Text_XYZ_H="Y"
Endif
if(YY1=-1)then
Text_XYZ_H="Y"
Di_H=-1
Endif
if(ZZ1=1)then
Text_XYZ_H="Z"
Endif
if(ZZ1=-1)then
Text_XYZ_H="Z"
Di_H=-1
Endif
if(XX2=1)then
Text_XYZ_V="X"
Endif
if(XX1=-1)then
Text_XYZ_V="X"
Di_V=-1
Endif
if(YY2=1)then
Text_XYZ_V="Y"
Endif
if(YY2=-1)then
Text_XYZ_V="Y"
Di_V=-1
Endif
if(ZZ2=1)then
Text_XYZ_V="Z"
Endif
if(ZZ2=-1)then
Text_XYZ_V="Z"
Di_V=-1
Endif
ifdAngle>0then
Di_V=-Di_V
endif
ifdAngle<0then
Di_H=-Di_H
endif
DimoSelasSelection
DimoVisPropsasVisPropertySet
setoSel=oDrwDocument.Selection
oSel.Clear
DimTextVAsint
TextV=R/2
'Drawthehorizontallline
fori=0TOny
ifdAngle=0then
setLine2D1=oFactory2D.CreateLine(X1-D/3,Y1+D*i,X1+nx*D+D/3,Y1+D*i)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(X1-D/3-R,Y1+D*i,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(X1-D/3-R*2,Y1+D*i,X1-D/3,Y1+D*i)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_V,X1-D/3-R,Y1+D*i+TextV)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((Y1+D*i)*Di_V,X1-D/3-R,Y1+D*i-TextV)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
ifdAngle>0then
setLine2D1=oFactory2D.CreateLine(X1-D/3,-Y1-D*i,X1+nx*D+D/3,-Y1-D*i)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(X1+nx*D+D/3+R,-Y1-D*i,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(X1+nx*D+D/3+R,-Y1-D*i+R,X1+nx*D+D/3+R,-Y1-D*i-R)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_V,X1+nx*D+D/3+R+TextV,-Y1-D*i)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((Y1+D*i)*Di_V,X1+nx*D+D/3+R-TextV,-Y1-D*i)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
ifdAngle<0then
setLine2D1=oFactory2D.CreateLine(-X1+D/3,Y1+D*i,-(X1+nx*D+D/3),Y1+D*i)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(-(X1+nx*D+D/3)-R,Y1+D*i,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(-X1-nx*D-D/3-R,Y1+D*i+R,-X1-nx*D-D/3-R,Y1+D*i-R)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_V,-X1-nx*D-D/3-R+TextV,Y1+D*i)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((Y1+D*i)*Di_V,-X1-nx*D-D/3-R-TextV,Y1+D*i)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
next
'Drawtheverticalline
forj=0TOnx
ifdAngle=0then
setLine2D1=oFactory2D.CreateLine(X1+D*j,Y1-D/3,X1+D*j,Y1+ny*D+D/3)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(X1+D*j,Y1+ny*D+D/3+R,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(X1+D*j-R,y1+ny*D+D/3+R,X1+D*J+R,y1+ny*D+D/3+R)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_H,X1+D*j,Y1+ny*D+D/3+R+TextV)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((X1+D*j)*Di_H,X1+D*j,y1+ny*D+D/3+R-TextV)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
ifdAngle>0then
setLine2D1=oFactory2D.CreateLine(X1+D*j,-Y1+D/3,X1+D*j,-Y1-ny*D-D/3)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(X1+D*j,-Y1+D/3+R,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(X1+D*j,-Y1+D/3+R*2,X1+D*J,-Y1+D/3)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_H,X1+D*j+TextV,-Y1+D/3+R)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((X1+D*j)*Di_H,X1+D*j-TextV,-Y1+D/3+R)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
ifdAngle<0then
setLine2D1=oFactory2D.CreateLine(-X1-D*j,Y1-D/3,-X1-D*j,Y1+ny*D+D/3)
oSel.AddLine2D1
setCircle2D1=oFactory2D.CreateClosedCircle(-X1-D*j,Y1-D/3-R,R)
oSel.AddCircle2D1
setLine2D1=oFactory2D.CreateLine(-X1-D*j,Y1-D/3-R*2,-X1-D*J,Y1-D/3)
oSel.AddLine2D1
SetMyText=oDrwView.Texts.Add(Text_XYZ_H,-X1-D*j+TextV,Y1-D/3-R)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
SetMyText=oDrwView.Texts.Add((X1+D*j)*Di_H,-X1-D*j-TextV,Y1-D/3-R)
MyText.AnchorPosition=catMiddleCenter
MyText.SetFontSize0,0,iFontSize
endif
next
dimoFontSizeAslong
'MyText.SetFontSize0,0,iFontSize
setoVisProps=oSel.VisProperties
oVisProps.SetRealWidth1,0'1stparameterlinewidth1-632ndparameterinheritanceflag1or0
oVisProps.SetRealColor0,255,0,1
SetoVisProps=Nothing
SetoSel=Nothing
'Updatedrawingtablemodifications
CATIA.ActiveWindow.ActiveViewer.Reframe
EndSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 位图 标线 自动 生成 程序 使用指南