set-wcs.grs

UG二次开发很好的东西 需要的朋友可以下载来看看 很好用啊

proc/rc,workcsys
entity/pnt1,pnt2,pnt3
entity/ln1,ln2
entity/cir1
entity/ent_csys
entity/workcsys
number/pt1(3),pt2(3),pt3(3),cp(3),resp,rc

rc=-1
rjt010:
choose/'选择确定工作坐标系的方法','三个点','两条直线',$
'园或圆弧','坐标系平面',resp
jump/rjt010:,term:,,,,two020:,arc030:,csy050:,wcs060:,resp

rjt020:
gpos/'提取第一个点',pt1,resp
jump/rjt020:,term:,,,,resp

rjt030:
gpos/'提取第二个点',pt2,resp
jump/rjt020:,term:,,,,resp

rjt040:
gpos/'提取第三个点',pt3,resp
jump/rjt030:,term:,,,,resp

pnt1=point/pt1
pnt2=point/pt2
pnt3=point/pt3
workcsys=csys/pnt1,pnt2,pnt3
&wcs=workcsys
delete/pnt1,pnt2,pnt3
rc=1
jump/term:

two020:
mask/3
ident/'选择第一条直线',ln1,cursor,cp,member,off,resp
call/'orient-line',ln1,cp
jump/two020:,term:,,resp

ident/'选择第二条直线',ln2,cursor,cp,member,off,resp
call/'orient-line',ln2,cp
jump/two020:,term:,,resp
workcsys=csys/ln1,ln2
&wcs=workcsys
rc=1
jump/term:

arc030:
mask/5,6
ident/'选择园或圆弧',cir1,resp
jump/arc030:,term:,,,,resp
workcsys=csys/cir1
&wcs=workcsys
rc=1
jump/term:

csy050:
mask/45
ident/'选择存在的坐标系',ent_csys,resp
jump/csy050:,term:,,,,resp

if/&type(ent_csys)<>45,jump/csy050:
workcsys=csys/ent_csys
&wcs=workcsys
rc=1
jump/term:

wcs060:
rc=1
jump/term:

term:
mask/all
return