diff options
| -rw-r--r-- | DXF.pm | 45 |
1 files changed, 26 insertions, 19 deletions
@@ -2,9 +2,12 @@ # Module to read/write DXF files -## Copyright (c) 2018-2020 by Thomas Kremer +## Copyright (c) 2018-2021 by Thomas Kremer ## License: GPL ver. 2 or 3 +# TODO: function for checking/repairing entities based on spec. +# -> add int and int_32 to all lwpolylines, etc. + package DXF; use strict; @@ -123,7 +126,7 @@ sub dxf_node_id { $_[0] =~ /^\$/ ? 9 : 0 } # dxf => 1, # VPORT => 1, # LTYPE => 1, -# +# # ); # -- basic parsing and construction -- @@ -181,7 +184,7 @@ sub parse_dxf { } my $parent = $contents[$begin]; my @children = splice(@contents,$begin+1,$i-$begin); - + # Preserve the endtag, as it may have individual attributes and # we don't want to drop any information at this stage. $parent->{endtag} = pop @children; @@ -232,7 +235,7 @@ sub lol2xml { @attrs = sort { ($a =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$a}) <=> - ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) + ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) } @attrs; for (@attrs) { my $attr = $_; @@ -316,7 +319,7 @@ sub drawing2dxflol { } } } - + my $lol = lol("dxf",[ minimal_header_lol(), # lol("SECTION",{name=>"HEADER"},[ @@ -348,7 +351,7 @@ sub lol2dxf { for my $attr (sort # { # ($a =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$a}) <=> -# ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) +# ($b =~ /^i(\d+)$/ ? $1 : $dxf_attr_ids{$b}) # } keys %$attrs) { next if $seen{$attr}; @@ -522,7 +525,7 @@ sub canonicalize { } $$sections{HEADER} //= minimal_header_lol(); $dxf->{children} = [@$sections{qw(HEADER CLASSES TABLES BLOCKS ENTITIES OBJECTS)}]; - + tree_walk($dxf,sub { delete $_[0][0]{endtag}; }); return 1; } @@ -568,7 +571,7 @@ sub get_block_replacement { my ($blocks,$node) = @_; my ($insblock,$x,$y,$z,$xscale,$yscale,$zscale,$rot,$cols,$rows,$colspace,$rowspace) = @{$node->{attrs}}{qw(name x y z float1 float2 float3 angle int int1 float4 float5)}; die "undefined block used" unless defined $blocks->{$insblock}; - die "incomplete block usage" unless $blocks->{$insblock}{finished}; + die "incomplete block usage" unless $blocks->{$insblock}{finished}; my @anchor = @{$blocks->{$insblock}{block}{attrs}}{qw(x y z)}; $_ //= 0 for @anchor,$colspace,$rowspace; $_ //= 1 for $cols,$rows; @@ -659,7 +662,7 @@ sub flatten { @$x = @$insobjects; # FIXME: recursion protection done right. #$blocks{$n}{finished} = 0; - #$ctx->{name} = $n; + #$ctx->{name} = $n; return 1; } },sub { @@ -771,7 +774,7 @@ sub merge_dxf { # what are OBJECTS anyway? Better delete them, there are some dictionaries there... my ($e1) = grep(($_->{attrs}{name}//"") eq "ENTITIES", @{$dxf1->{children}}); my @e2 = grep(($_->{attrs}{name}//"") eq "ENTITIES", @{$dxf2->{children}}); - + push @{$e1->{children}}, map @{$_->{children}}, @e2; return $dxf1; } @@ -789,7 +792,7 @@ sub colorize_dxf { return $dxf; } -# POINT, LINE, SPLINE, POLYLINE, LWPOLYLINE, CIRCLE, ARC, ELLIPSE, TEXT, INCLUDE, +# POINT, LINE, SPLINE, POLYLINE, LWPOLYLINE, CIRCLE, ARC, ELLIPSE, TEXT, INCLUDE # POLYLINE # SPLINE----------------------> v @@ -797,7 +800,7 @@ sub colorize_dxf { # CIRCLE------^ # spline -> circle: -# p1 ---p2 p3 +# p1 ---p2 p3 # | | # | __-- p4 # X--M2-- @@ -816,7 +819,7 @@ sub colorize_dxf { # l^2 + 2*l*x + 2*l*y + 2*x*y*(1-c) = 0 # y = -(l^2 + 2*l*x)/(2*l + 2*x*(1-c)) # m := r1/r2 = (a+x)/(b-y) -# y = b-(a+x)/m +# y = b-(a+x)/m # b-(a+x)/m = -(l^2 + 2*l*x)/(2*l + 2*x*(1-c)) # (b-(a+x)/m)*(2*l + 2*x*(1-c)) = -(l^2 + 2*l*x) # 2*(b*m-a-x)*(l + x*(1-c)) + l^2*m = -2*l*x*m @@ -861,7 +864,8 @@ my %replacers = ( splice @sx,0,3; splice @sy,0,3; } - return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0, + int_32 => scalar(@x)}); }, POLYLINE => sub { my $node = shift; @@ -873,7 +877,8 @@ my %replacers = ( push @x, $_->{attrs}{x}; push @y, $_->{attrs}{y}; } - return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0, + int_32 => scalar(@x)}); }, # DONE: Test whether my idea of an ellipse is the same as librecad's. ELLIPSE => sub { @@ -908,14 +913,16 @@ my %replacers = ( push @x, $qx; push @y, $qy; } - return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0}); + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => $closed?1:0, + int_32 => scalar(@x)}); }, LINE => sub { my $node = shift; my (@x,@y); @x = @{$node->{attrs}}{qw(x x1)}; @y = @{$node->{attrs}}{qw(y y1)}; - return lol(LWPOLYLINE => {x => \@x, y => \@y, int => 0}); + return lol(LWPOLYLINE => {x => \@x, y => \@y, int => 0, + int_32 => scalar(@x)}); }, }, ELLIPSE => { @@ -1172,7 +1179,7 @@ sub _need_vars_and_types { my $name = $_->{name}; $name =~ s/^$//; my @k = keys %{$_->{attrs}}; - + my ($type,$value) = @k == 1 ? ($k[0],$_->{attrs}{$k[0]}) : @k == 0 ? () : defined $_->{attrs}{x} ? ("point",[@{$_->{attrs}}{qw(x y z)}]) : @@ -1363,7 +1370,7 @@ sub fulfill_version_requirements { # AC1024 = AutoCAD 2010 # AC1027 = AutoCAD 2013 # AC1032 = AutoCAD 2018 - + sub version { my ($self,$newver) = @_; if (@_ > 1) { |