\ Rules for translating AutoCAD Release 11 DXF files to Release 10 \ Version 1.1 -- February 21, 1991 .( "Release 11 -> 10 DXF translator, Version 1.1 (2/21/91)\n" \ ************ START DEBUG-ONLY STUFF *************** \ Initialization routine : dxf:start \ -1 dumpinput ! \ Un-comment to dump input items \ -1 dumpoutput ! \ Un-comment to dump output items \ 6 outprec ! \ Un-comment to force ASCII output ; \ Manual translation program (equivalent to the standard loop, so it's \ commented out). \ : dxf:translate \ begin \ readitem while \ writeitem drop \ repeat \ ; \ Print point on stack 80 string edbuf : point. \ x y z -- 2rot "(%g," edbuf fstrform edbuf type 2swap "%g" edbuf fstrform edbuf type 2dup missing_z 2@ f= if ")" else ",%g)" edbuf fstrform edbuf then type ; \ ************* END DEBUG-ONLY STUFF ************** \ Defining words to make common translation operations easier \ and more expressive to specify. \ REMOVE DXF:bilge:rat -- Causes all instances of item RAT in section \ BILGE to be removed. (An explicit section \ name is expected; "*" is not valid here) : remove create does> drop 1 delitem ! ; \ DROP_Z DXF:header:$zilch -- The Z co-ordinate will be deleted from \ header variable ZILCH. : drop_z create does> drop 10 group 2drop missing_z 2@ 10 setgroup ; \ bitmask MASKFIELD DXF:*:*: -- AND a field with a bitmask : maskfield create , \ Compile bitmask does> over \ Duplicate group index group \ Extract value of group swap \ Move bitmask address to the top @ \ Get value of bitmask and \ Mask the value of the field swap \ Get group code on top setgroup \ Update group in item \ stdout printitem ; \ DITCHGROUP DXF:*:: : ditchgroup create does> drop \ Get rid of word's address delgroup \ Delete this group from item ; \ ERRAT -- End an error message by editing the location in the \ file that the error occurred. : errat ." " at " itempos inbinary @ if "byte 0x%lX" else 1+ "line %ld" then edbuf strform edbuf type ." " of input file.\n" ; \ TEXTVADJ DXF:*:: -- Translate new-format separate \ horizontal and vertical text \ alignment modes. : textvadj create does> drop \ Get rid of word's address dup \ Copy vertical alignment group code 72 group? if 72 group \ Get horizontal alignment else 0 \ No horizontal alignment, assume Left then ( Settings for horizontal alignment of 3, 4, and 5 override any value present in the vertical alignment field [73 group for Text, 74 group for Attdef/Attrib]. It isn't clear how this could come to pass except through entmod or DXF, but if we find one, just ditch the redundant 73/74 group without complaining. ) dup dup 2 > swap 6 < and if drop \ Drop horizontal alignment drop \ Drop copy of vertical group code \ ." "Dropped vert. text alignment, overridden by horiz. alignment.\n" else ( We translate the new "MCenter" alignment into the old "Middle" alignment. This is usually, but not always, appropriate. ) 1 = over group 2 = and if drop \ Drop copy of vertical group code \ ." "Translated MCenter text alignment.\n" 4 72 setgroup else group 0<> if \ If vertical alignment not Baseline 72 group? if 72 delgroup \ Discard horizontal alignment group then 11 group? if 11 delgroup \ Drop alignment point then ." "Text alignment lost--reset to left/baseline\n" ." " for entity with text: \"" 1 group type ." "\"" errat then then then delgroup \ Discard vertical alignment group ; ( Process command line options and set special operating modes ) : modeset "d" option if \ If -D option is set, turn on trace 1 dxftrace ! then ; \ End of defining words. Let the fun begin! modeset \ Process command line options ( Header variables to delete or modify ) remove dxf:header:$dimclrd \ Dimension line colour remove dxf:header:$dimclre \ Dimension extension line colour remove dxf:header:$dimclrt \ Dimension text colour remove dxf:header:$dimgap \ Dimension block gap remove dxf:header:$dimstyle \ Current dimension style remove dxf:header:$dimtfac \ Dimension text vertical position remove dxf:header:$maxactvp \ Maximum active viewports remove dxf:header:$pelevation \ Paper elevation remove dxf:header:$pextmax \ Paper maximum extents remove dxf:header:$pextmin \ Paper minimum extents remove dxf:header:$pinsbase \ Paper insertion base remove dxf:header:$plimcheck \ Paper limit checking remove dxf:header:$plimmax \ Paper maximum limits remove dxf:header:$plimmin \ Paper minimum limits remove dxf:header:$pucsname \ Paper UCS name remove dxf:header:$pucsorg \ Paper UCS origin remove dxf:header:$pucsxdir \ Paper UCS X direction remove dxf:header:$pucsydir \ Paper UCS Y direction remove dxf:header:$shadedge \ SHADE command edge rendering mode remove dxf:header:$shadedif \ Shading diffuse illumination factor remove dxf:header:$tilemode \ Tiled viewports mode remove dxf:header:$unitmode \ Drawing unit mode bits remove dxf:header:$visretain \ Layer/viewport visibility retention drop_z dxf:header:$extmax \ Flatten maximum extents drop_z dxf:header:$extmin \ Flatten minimum extents : dxf:header:$dimscale \ $DIMSCALE needs special processing 40 group 0.0 f= if \ If it's zero (for paper space)... 1.0 40 setgroup \ ...substitute 1.0 then ; ( Symbol tables to delete or modify ) remove dxf:tables:appid \ Registered application table remove dxf:tables:dimstyle \ Dimension style table : dxf:tables:layer \ For the LAYER table... 0 group "LAYER" strcmp 0= \ For each LAYER (but not TABLE/ENDTAB) 70 group? and if \ If there's a 70 (flags) group... 70 group 48 and if \ ...and its 16 or 32 bits are set... 1 delitem ! \ ...drop this dependent layer else 70 group 1 and \ else zero any new flag bits... 70 setgroup \ ...and update the 70 group then then ; ( Entities to delete ) remove dxf:blocks:viewport \ Viewport entities in blocks remove dxf:entities:viewport \ Viewport entities ( Block definition transformations ) : dxf:blocks:block \ In block definition... 70 group? if 70 group 3 and 70 setgroup \ ... clear Xref & dependent bits then 1 delgroup \ Remove Xref path group... 3 delgroup \ ...and new block name group ; ( Dimension entity transformations ) ditchgroup dxf:*:dimension:3 \ Drop dimension style ditchgroup dxf:*:dimension:52 \ Drop obliquing angle ditchgroup dxf:*:dimension:53 \ Drop text rotation angle ditchgroup dxf:*:dimension:54 \ Drop bogus extra angle if present ( Delete extended entity data ) ditchgroup dxf:*:*:1000-1100 \ Drop all Xdata fields ( Translate vertical text alignment ) textvadj dxf:*:text:73 textvadj dxf:*:attdef:74 textvadj dxf:*:attrib:74 ( Delete paper space entities and the space indicator ) : dxf:*:*:67 group 0= if 67 delgroup \ Model space entity: drop 67 group else 1 delitem ! \ Paper space entity: drop the entity then ; \ Termination processing : dxf:end "m" option if \ If -M option is set, print memory stats memstat then "End translation.\n" type depth if .s cr ;