📄 atlast.dxt
字号:
edbuf strlen 1+
edbuf ofile fwrite drop
else
" 0" ofile fputs drop
edbuf ofile fputs drop
then
addLayer
addHandle
;
\ Stack on entering: Stack on leaving:
: addVertexTrailer ( ... ) ( ... )
inbinary @ if
70 ofile fputc drop
32 ofile fputshort drop
else
" 70" ofile fputs drop
" 32" ofile fputs drop
then
;
\ Stack on entering: Stack on leaving:
: addSequend ( ... ) ( ... )
"SEQEND" edbuf strcpy
inbinary @ if
0 ofile fputc drop
edbuf strlen 1+
edbuf ofile fwrite drop
else
" 0" ofile fputs drop
edbuf ofile fputs drop
then
addLayer
addHandle
;
\ Stack on entering: Stack on leaving:
: add10Group ( ... x y z ) ( ... )
inbinary @ if
10 ofile fputc drop
2 2roll ( ... y z x )
ofile fputd drop ( ... y z )
20 ofile fputc drop
2swap ( ... z y )
ofile fputd drop ( ... z )
30 ofile fputc drop
ofile fputd drop ( ... )
else
" 10" ofile fputs drop
2 2roll ( ... y z x )
"%#g" edbuf fstrform ( ... y z )
edbuf ofile fputs drop
" 20" ofile fputs drop
2swap ( ... z y )
"%#g" edbuf fstrform ( ... z )
edbuf ofile fputs drop
" 30" ofile fputs drop
"%#g" edbuf fstrform ( ... )
edbuf ofile fputs drop
then
;
: dxf:header:$extmin
true minset !
10 group ( ... x y z )
zmin 2!
ymin 2!
xmin 2!
;
\ Stack on entering: Stack on leaving:
: addColor
62group @ if
inbinary @ if
62 ofile fputc drop
color @ ofile fputshort drop
else
" 62" ofile fputs drop
color @ "%ld" edbuf strform
edbuf ofile fputs drop
then
then
;
\ Stack on entering: Stack on leaving:
: addPolylineHeader ( ... ) ( ... )
"POLYLINE" edbuf strcpy
inbinary @ if
0 ofile fputc drop
edbuf strlen 1+
edbuf ofile fwrite drop
else
" 0" ofile fputs drop
edbuf ofile fputs drop
then
addLayer
addHandle
addColor
inbinary @ if
66 ofile fputc drop
1 ofile fputshort drop
else
" 66" ofile fputs drop
" 1" ofile fputs drop
then
add10Group
;
: add3dPolylineHeader ( ... ) ( ... )
inbinary @ if
70 ofile fputc drop
8 ofile fputshort drop
else
" 70" ofile fputs drop
" 8" ofile fputs drop
then
;
: addVertex
addVertexHeader
add10Group
;
\ Stack on entering: Stack on leaving:
: saveOffset ( ... ) ( ... )
10 group ( ... x y z )
0 2 offset element 2!
0 1 offset element 2!
0 0 offset element 2!
;
: dxf:*:ellipse
saveLayer
saveOffset
removeXdata
11 group ( ... x y z )
\ Calculate the parameter 'a' for the ellipse equation: x = a cos(theta), y = b sin(theta)
vectorLength 2dup ellipsea 2! ( ... len )
\ Calculate the parameter 'b'.
40 group ( ... len p )
f* ellipseb 2! ( ... )
\ end angle
42 group ( ... e )
2dup ellipseEndAngle 2! ( ... e )
\ start angle
41 group ( ... e s )
2dup ellipseStartAngle 2! ( ... e s )
f- fabs ( ... deltaangle )
2pi f- fabs
ellipseanglefuzz f< if
\ A full ellipse, not an elliptical arc.
2pi ( ... 2pi )
else
\ An elliptical arc.
\ Calculate the start angle.
ellipseStartAngle 2@ ( ... s )
normalizeEllipseAngle ( ... s )
2dup ellipseStartAngle 2! ( ... s )
\ Calculate the end angle.
ellipseEndAngle 2@ ( ... s e )
normalizeEllipseAngle ( ... s e)
2dup ellipseEndAngle 2! ( ... s e )
f> if
\ Start angle greater than end angle.
2pi ellipseStartAngle 2@ f-
ellipseEndAngle 2@ f+
else
ellipseEndAngle 2@ ( ... e )
ellipseStartAngle 2@ ( ... s )
f- ( ... arcangle )
then
then
ellipseSteps float f/
ellipseangleincr 2!
\ Set up the rotation matrix.
210 group ( ... x3 y3 z3 )
vector2dup ( ... x3 y3 z3 x3 y3 z3 )
2 2 rotationMatrix element 2! ( ... x3 y3 z3 x3 y3 )
2 1 rotationMatrix element 2! ( ... x3 y3 z3 x3 )
2 0 rotationMatrix element 2! ( ... x3 y3 z3 )
11 group ( ... x3 y3 z3 x y z )
makeUnitVector ( ... x3 y3 z3 x1 y1 z1 )
vector2dup ( ... x3 y3 z3 x1 y1 z1 x1 y1 z1 )
0 2 rotationMatrix element 2! ( ... x3 y3 z3 x1 y1 z1 x1 y1 )
0 1 rotationMatrix element 2! ( ... x3 y3 z3 x1 y1 z1 x1 )
0 0 rotationMatrix element 2! ( ... x3 y3 z3 x1 y1 z1 )
crossProduct ( ... x4 y4 z4 )
1 2 rotationMatrix element 2! ( ... x4 y4 )
1 1 rotationMatrix element 2! ( ... x4 )
1 0 rotationMatrix element 2! ( ... )
"POLYLINE" 0 setgroup \ Turn an ELLIPSE into a POLYLINE
\ Need to set point from the 0th VERTEX here.
11 delgroup
40 delgroup
41 delgroup
42 delgroup
48 delgroup
66 group? not if
66 addgroup
then
1 66 setgroup
70 group? not if
70 addgroup
then
8 70 setgroup
210 delgroup
0 ellipseStepToPoint ( ... x y z )
ellipseApplyTransform
10 setgroup ( ... )
\ Need to force a write of this item in order to append explicit VERTEX items.
writeitem drop
\ Calculate points on the ellipse.
ellipseSteps 1+ 0 do
i ellipseStepToPoint ( ... x y z )
ellipseApplyTransform
\ 2pointprint
addVertex
addVertexTrailer
loop
addSequend
;
: dxf:entities:dimension
\ -3 delgroup
3 delgroup
;
\ : dxf:entities:insert
\ -3 delgroup
\ ;
\ : dxf:entities:viewport
\ -3 delgroup
\ ;
: dxf:entities:seqend
-2 delgroup
;
: addRotationAngle ( ... ) ( ... )
textRotation 2@ 0.0 f= not if
inbinary @ if
50 ofile fputc drop
else
" 50" ofile fputs drop ( ... x y z )
then
textRotation 2@
inbinary @ if
ofile fputd drop
else
"%#g" edbuf fstrform
edbuf ofile fputs drop
then
then
;
\ Stack on entering: Stack on leaving:
: getArbitraryXAxis ( ... x y z ) ( ... x3 y3 z3 )
\ See pg. 272 of the AutoCAD R12 Customization Manual.
2 2pick ( ... x y z x )
\ 0.015625 = 1/64
0.015625 f< if ( ... x y z )
1 2pick ( ... x y z y )
0.015625 f< if ( ... x y z )
0.0 1.0 0.0 ( ... x y z 0.0 1.0 0.0 )
else ( ... x y z )
0.0 0.0 1.0 ( ... x y z 0.0 0.0 1.0 )
then
else ( ... x y z )
0.0 0.0 1.0 ( ... x y z 0.0 0.0 1.0 )
then
vector2swap ( ... 0.0 0.0 1.0 x y z )
crossProduct ( ... x2 y2 z2 )
makeUnitVector ( ... x3 y3 z3 )
;
\ Stack on entering: Stack on leaving:
: saveExtrusion ( ... ) ( ... )
0.0 2dup ( ... ang ang )
textRotation 2! ( ... ang )
textRotationPrimary 2! ( ... )
210 group? if
210 group ( ... Zx Zy Zz )
vector2dup ( ... Zx Zy Zz Zx Zy Zz )
\ Set up the rotation matrix Z
2 2 rotationMatrix element 2!
1 2 rotationMatrix element 2!
0 2 rotationMatrix element 2! ( ... Zx Zy Zz )
vector2dup ( ... Zx Zy Zz Zx Zy Zz )
getArbitraryXAxis ( ... Zx Zy Zz Xx Xy Xz )
vector2dup ( ... Zx Zy Zz Xx Xy Xz Xx Xy Xz )
\ Set up the rotation matrix X
2 0 rotationMatrix element 2!
1 0 rotationMatrix element 2!
0 0 rotationMatrix element 2! ( ... Zx Zy Zz Xx Xy Xz )
vector2dup ( ... Zx Zy Zz Xx Xy Xz Xx Xy Xz )
8 2pick ( ... Zx Zy Zz Xx Xy Xz Xx Xy Xz Zx )
8 2pick ( ... Zx Zy Zz Xx Xy Xz Xx Xy Xz Zx Zy )
8 2pick ( ... Zx Zy Zz Xx Xy Xz Xx Xy Xz Zx Zy Zz )
vector2swap ( ... Zx Zy Zz Xx Xy Xz Zx Zy Zz Xx Xy Xz )
crossProduct ( ... Zx Zy Zz Xx Xy Xz Yx Yy Yz )
makeUnitVector
\ Set up the rotation matrix Y
2 1 rotationMatrix element 2!
1 1 rotationMatrix element 2!
0 1 rotationMatrix element 2! ( ... Zx Zy Zz Xx Xy Xz )
\ Now transform the offset from World Coordinate System to Local CS.
offset rotationMatrix 1x33x3multiply
0 0 result element 2@ ( ... Zx Zy Zz Xx Xy Xz Xlcs )
0 1 result element 2@ ( ... Zx Zy Zz Xx Xy Xz Xlcs Ylcs )
0 2 result element 2@ ( ... Zx Zy Zz Xx Xy Xz Xlcs Ylcs Zlcs )
0 2 offset element 2!
0 1 offset element 2!
0 0 offset element 2! ( ... Zx Zy Zz Xx Xy Xz )
2drop 2swap ( ... Zx Zy Zz Xy Xx )
atan2 ( ... Zx Zy Zz rad )
2.0 pi f* 2swap f- ( ... Zx Zy Zz 2pi-rad )
radToDeg f* ( ... Zx Zy Zz arbAxisAng )
\ Get angle between WCS X-axis and LCS X-axis
11 group? if ( ... Zx Zy Zz arbAxisAng )
11 group ( ... Zx Zy Zz arbAxisAng x y z )
0 2 vector element 2!
0 1 vector element 2!
0 0 vector element 2!
vector rotationMatrix 1x33x3multiply
0 1 result element 2@ ( ... Zx Zy Zz arbAxisAng y )
0 0 result element 2@ ( ... Zx Zy Zz arbAxisAng y x )
atan2 radToDeg f* ( ... Zx Zy Zz arbAxisAng LCSang )
1.0 0.0 0.0 ( ... Zx Zy Zz arbAxisAng LCSang 1.0 0.0 0.0 )
2 0 rotationMatrix element 2@
1 0 rotationMatrix element 2@
0 0 rotationMatrix element 2@ ( ... Zx Zy Zz arbAxisAng LCSang 1.0 0.0 0.0 x y z )
vectorangle radToDeg f* ( ... Zx Zy Zz arbAxisAng LCSang theta )
f+ ( ... Zx Zy Zz arbAxisAng rotationAng )
2dup ( ... Zx Zy Zz arbAxisAng rotationAng rotationAng )
textRotationPrimary 2! ( ... Zx Zy Zz arbAxisAng roationAng )
f+ ( ... Zx Zy Zz arbAxisAng2 )
textRotation 2! ( ... Zx Zy Zz )
then
else
\ Indicates no 210 group was present.
0.0 0.0 0.0
then
0 2 extrusion element 2!
0 1 extrusion element 2!
0 0 extrusion element 2!
;
\ Stack
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -