DMISMN/''
$$ *** 程序初始段 ***
MODE/MAN
RECALL/D(MAC)
WKPLAN/XYPLAN
UNITS/MM,ANGDEC,TEMPC
TECOMP/OFF
PTBUFF/ON
SNSET/DEPTH,0.0000
SNSET/CLRSRF,OFF
FLY/5.0000
FEDRAT/MESVEL,PCENT,0.50
FEDRAT/POSVEL,PCENT,0.75
FEDRAT/ROTVEL,PCENT,0.75
FEDRAT/SCNVEL,PCENT,0.75
ACLRAT/MESACL,PCENT,0.75
ACLRAT/POSACL,PCENT,0.75
V(TEXT)=VFORM/ALL
V(HTML)=VFORM/DME,'HTM',ALL
V(SPCLIGHT)=VFORM/STAT,'SDD',ALL
V(QSSTATQ)=VFORM/STAT,'DFQ',ALL
V(QSSTATD)=VFORM/STAT,'DFD',ALL
V(GRAPHF)=VFORM/DME,'DMG',ALL
V(GRAPHV)=VFORM/DME,'DMG/V',ALL
V(GRAPHP)=VFORM/DME,'DMG/P',ALL
V(GRAPHO)=VFORM/DME,'DMG/O',ALL
V(GRAPHA)=VFORM/DME,'DMG/A',ALL
$$ *** 程序初始段结束 ***
$$============无测头半径补偿!!!=================
$$THIS MACRO USED FOR MEASURING A PLANE IN CNC MODE
$$YOU PICK UP FOUR POINTS TO DEFINE A QUADRANGLE, AND DEFINE HOW MANY POINTS FOR
$$U DIR AND HOW MANY POINT FOR V DIR TO PICK UP THIS PLANE IN CNC MODE. THE TOTAL POINTS IS U*V
$$U IS FORM P1 TO P2, V IS FROM P1 TO P4.
$$****************************************************************
$$ CREATED AND MODIFIED BY TALL ZHANG ON MARCH, 2001, BRUZOLO
$$ MODIFED BY TALL ZHANG ON 3, NOV,2002, SHENZHEN
$$ DMIS version modified by Tall Zhang on 22, Mar,2005, Huibei Auto Institute
$$ 特点: 测量点可以自动随曲面爬升,测量点均匀分布于四边形内,没有漏点现象.
$$****************************************************************
TEXT/OPER,'曲面四边形采点程序'
PRCOMP/OFF
$$OPENING THE OUTPUT FILE
DECL/CHAR,64,FILENAME
FILENAME=PROMPT/'ENTER THE NAME OF THE DATA FILE WITHOUT EXTENSION(请输入一个数据文件名!)'
FILENAME=ASSIGN/CONCAT('d:\DATA\',FILENAME,'.TXT')
DID(FILEDATI)=DEVICE/STOR,FILENAME
OPEN/DID(FILEDATI),DIRECT,OUTPUT,OVERWR
$$SELECTING THE PROBE
TEXT/QUERY,(TASTATORE),256,AN,L,'Probe Name(请输入一个测头编号!如:P1_0_0P0_0)'
SNSLCT/SA()
DECL/REAL,PHIT
PHIT=PROMPT/'接近距离?'
SNSET/SEARCH,100.000
SNSET/APPRCH,PHIT
SNSET/RETRCT,PHIT
DECL/INTGR,NUM1,NUM2
NUM1=PROMPT/'HOW MANY POINTS ON A LINE/每条线上多少个点?'
IF/ (NUM1 .LT. 2)
NUM1 =ASSIGN/2
ENDIF
NUM1=ASSIGN/NUM1-1
NUM2=PROMPT/'HOW MANY LINES/多少条线?'
IF/ (NUM2 .LT. 2)
NUM2 =ASSIGN/2
ENDIF
NUM2=ASSIGN/NUM2-1
DECL/INTGR, ZIG,S3D
ZIG=PROMPT/'1--往复测量， 0--单向测量'
S3D=ASSIGN/1
$$S3D=PROMPT/'YES--快速采点， NO--精确采点'
IF/ (S3D .EQ. 0)
DECL/REAL,WID
WID=PROMPT/'微平面的宽度?'
WID=ASSIGN/(WID/2)
ENDIF
TEXT/OPER,'PICK UP 1ST POINT'
F(PO1)=FEAT/POINT,CART,0,0,0,0,0,1
MEAS/POINT,F(PO1),1
ENDMES
TEXT/OPER,'PICK UP 2ED POINT'
F(PO2)=FEAT/POINT,CART,0,0,0,0,0,1
MEAS/POINT,F(PO2),1
ENDMES
TEXT/OPER,'PICK UP 3TH POINT'
F(PO3)=FEAT/POINT,CART,0,0,0,0,0,1
MEAS/POINT,F(PO3),1
ENDMES
TEXT/OPER,'PICK UP 4TH POINT'
F(PO4)=FEAT/POINT,CART,0,0,0,0,0,1
MEAS/POINT,F(PO4),1
ENDMES
TEXT/OPER,'把测头放置于安全平面高度上'
MODE/PROG,MAN
DECL/DOUBLE,PX,PY,PZ,PI,PJ,PK
PX=OBTAIN/FA(PO1),3
PY=OBTAIN/FA(PO1),4
PZ=OBTAIN/FA(PO1),5
PI=OBTAIN/FA(PO1),6
PJ=OBTAIN/FA(PO1),7
PK=OBTAIN/FA(PO1),8
F(PO5)=FEAT/POINT,CART,PX,PY,PZ,PI,PJ,PK
F(PL1)=FEAT/PLANE,CART,0,0,0,0,0,1
CONST/PLANE,F(PL1),BF,FA(PO1),FA(PO2),FA(PO3),FA(PO4)
$$===========GET Current Tip Position=======
F(PO8)=FEAT/POINT,CART,0,0,0,0,0,1
MEAS/POINT,F(PO8),0
ENDMES
$$========Bulid clearance Plane=========
PX=OBTAIN/FA(PO8),3
PY=OBTAIN/FA(PO8),4
PZ=OBTAIN/FA(PO8),5
PI=OBTAIN/FA(PL1),6
PJ=OBTAIN/FA(PL1),7
PK=OBTAIN/FA(PL1),8
F(PL3)=FEAT/PLANE,CART,PX,PY,PZ,PI,PJ,PK
DECL/REAL,P1X,P1Y,P1Z,P2X,P2Y,P2Z,P3X,P3Y,P3Z,P4X,P4Y,P4Z
P1X=OBTAIN/FA(PO1),3
P1Y=OBTAIN/FA(PO1),4
P1Z=OBTAIN/FA(PO1),5
P2X=OBTAIN/FA(PO2),3
P2Y=OBTAIN/FA(PO2),4
P2Z=OBTAIN/FA(PO2),5
P3X=OBTAIN/FA(PO3),3
P3Y=OBTAIN/FA(PO3),4
P3Z=OBTAIN/FA(PO3),5
P4X=OBTAIN/FA(PO4),3
P4Y=OBTAIN/FA(PO4),4
P4Z=OBTAIN/FA(PO4),5
DECL/REAL,VX1,VY1,VZ1,VX2,VY2,VZ2,UVX,UVY,UVZ
DECL/INTGR,UU,VV
DO/ VV,0,NUM2,1
VX1=ASSIGN/(P1X*VV+P4X*(NUM2-VV))/NUM2
VY1=ASSIGN/(P1Y*VV+P4Y*(NUM2-VV))/NUM2
VZ1=ASSIGN/(P1Z*VV+P4Z*(NUM2-VV))/NUM2
VX2=ASSIGN/(P2X*VV+P3X*(NUM2-VV))/NUM2
VY2=ASSIGN/(P2Y*VV+P3Y*(NUM2-VV))/NUM2
VZ2=ASSIGN/(P2Z*VV+P3Z*(NUM2-VV))/NUM2
DO/ UU,0,NUM1,1
IF/ (ZIG .EQ. 1)
UVX=ASSIGN/(VX2*UU+VX1*(NUM1-UU))/NUM1
UVY=ASSIGN/(VY2*UU+VY1*(NUM1-UU))/NUM1
UVZ=ASSIGN/(VZ2*UU+VZ1*(NUM1-UU))/NUM1
ELSE
UVX=ASSIGN/(VX1*UU+VX2*(NUM1-UU))/NUM1
UVY=ASSIGN/(VY1*UU+VY2*(NUM1-UU))/NUM1
UVZ=ASSIGN/(VZ1*UU+VZ2*(NUM1-UU))/NUM1
ENDIF
F(PO6)=FEAT/POINT,CART,UVX,UVY,UVZ,0,0,1
IF/ (UU .EQ. 0)
F(PO7)=FEAT/POINT,CART,0,0,0,0,0,1
CONST/POINT,F(PO7),PROJPT,F(PO6),F(PL3)
DECL/REAL,PX,PY,PZ
PX=OBTAIN/FA(PO7),3
PY=OBTAIN/FA(PO7),4
PZ=OBTAIN/FA(PO7),5
GOTO/PX,PY,PZ
ELSE
PX=OBTAIN/FA(PO5),3
PY=OBTAIN/FA(PO5),4
PZ=OBTAIN/FA(PO5),5
PI=OBTAIN/FA(PL1),6
PJ=OBTAIN/FA(PL1),7
PK=OBTAIN/FA(PL1),8
F(PL2)=FEAT/PLANE,CART,PX,PY,PZ,PI,PJ,PK
F(PO7)=FEAT/POINT,CART,0,0,0,0,0,1
CONST/POINT,F(PO7),PROJPT,F(PO6),F(PL2)
UVX=OBTAIN/FA(PO7),3
UVY=OBTAIN/FA(PO7),4
UVZ=OBTAIN/FA(PO7),5
ENDIF
IF/ (S3D .EQ. 1)
MEAS/POINT,F(PO5),1
PTMEAS/CART,UVX,UVY,UVZ,PI,PJ,PK
ENDMES
ELSE
$$GOSUB PICK3D
ENDIF
PX=OBTAIN/FA(PO5),3
PY=OBTAIN/FA(PO5),4
PZ=OBTAIN/FA(PO5),5
WRITE/DID(FILEDATI),PX,',',PY,',',PZ
ENDDO
F(PO7)=FEAT/POINT,CART,0,0,0,0,0,1
CONST/POINT,F(PO7),PROJPT,FA(PO5),F(PL3)
PX=OBTAIN/FA(PO7),3
PY=OBTAIN/FA(PO7),4
PZ=OBTAIN/FA(PO7),5
GOTO/PX,PY,PZ
ZIG=ASSIGN/-ZIG
ENDDO
CLOSE/DID(FILEDATI)
PRCOMP/ON
MODE/MAN
ENDFIL
