Subject:
|
Re: Spheroid Generator (Perl) makes DAT
|
Newsgroups:
|
lugnet.cad.dev
|
Date:
|
Mon, 15 Jul 2002 02:37:19 GMT
|
Viewed:
|
481 times
|
| |
|
|
#!perl5
# Spheroid.pl
# This program generates 1/4 of a dome or other shape
# Written by Erik Olson
# You will need to edit this sample code to get what you want:
$s = SpheroidSection::Sample(1);
# Add your desired shapes to the Sample() function or do it here like so:
# $s = new SpheroidSection(1, 4, 4, 10); # makes a 4x4 sphere section
$wantldraw = 1;
if ($wantldraw)
{
print $s->Ldraw(4);
# (black is 0, blue is 1, green is 2, red is 4, grey is 7, yellow is 14,
# white is 15)
# sand green might be 378 (dithered)
}
else
{
print $s->TextInstructions();
}
exit;
package SpheroidSection;
# Make a sample spheroid, your choices are 1 through 6
sub Sample
{
my ($x) = @_;
my ($s);
if ($x == 1) {
$s = new SpheroidSection(1, 8, 8, 20); # Sphere variation 1
} elsif ($x == 2) {
$s = new SpheroidSection(1, 8, 8, 10); # a squashed Sphere
} elsif ($x == 3) {
$s = new SpheroidSection(5, 8, 8, 20); # Cone variation 1
} elsif ($x == 4) {
$s = new SpheroidSection(5, 8, 8, 10); # low Cone
} elsif ($x == 5) {
$s = new SpheroidSection(9, 8, 8, 20); # Tent variation 1
} elsif ($x == 6) {
$s = new SpheroidSection(9, 8, 8, 10); # low tent
} else {
die "Sample object number $x not known, try 1 through 6\n";
}
return $s;
}
# For a good sphere, give height as 2.5 times width
# (Height is measured in plates)
sub new
{
my ($that, $rule, $xradius, $yradius, $height) = @_;
my $class = ref($that) || $that;
my ($self) = {};
bless $self, $class;
$self->{rule} = $rule;
$self->{xradius} = $xradius;
$self->{yradius} = $yradius;
$self->{height} = $height;
$self->Generate();
return $self;
}
# Calculate all the positions in steps[] that should be occupied by a plate
sub Generate
{
my ($self) = @_;
my ($grid, $x, $y, $z, $h);
# steps indexed by z, y, x. 0,0,0 is innermost stud of spheroid section.
my $steps = $self->{steps} = [];
for ($z = 0; $z < $self->{height}; $z++)
{
$steps->[$z] = []; # initialize array
for ($y = 0; $y<$self->{yradius}; $y++)
{
$steps->[$z]->[$y] = []; # initialize array
for ($x = 0; $x<$self->{xradius}; $x++)
{
$steps->[$z]->[$y]->[$x] = 0; # initialize cell
# determine if point is inside, using stud center
if ($self->InsideTest($self->{rule}, $x, $y, $z, $radius,
$radius, $height))
{
$steps->[$z]->[$y]->[$x] = 1;
}
}
}
}
}
# Printable ASCII instructions
# Subroutine returns a big string
# "O" marks a piece
# "*" marks a piece from previous step for guidance
# "." is no piece
sub TextInstructions
{
my ($self) = @_;
my ($a, $b) = (0,0);
my ($c);
my ($text);
# print step by step picture
for ($z = 0; $z < $self->{height}; $z++)
{
$text .= sprintf( "Step %d\n",$z+1);
for ($y = 0; $y<$self->{yradius}; $y++)
{
for ($x = 0; $x<$self->{xradius}; $x++)
{
$a = $self->{steps}->[$z]->[$y]->[$x];
$b = $self->{steps}->[$z-1]->[$y]->[$x] unless $z==0;
$c = $a ? "O" : $b ? "*" : ".";
$text .= $c;
}
$text .= "\n";
}
$text .= "\n";
}
return $text;
}
# LDRAW instruction or model file using 1x1 plates, part 3024
# Subroutine returns a big string
sub Ldraw
{
my ($self, $color) = @_;
my ($a, $b) = (0,0);
my ($c);
my ($text);
my ($imatrix) = "1 0 0 0 1 0 0 0 1";
my ($part) = "3024.DAT";
for ($z = 0; $z < $self->{height}; $z++)
{
$text .= sprintf( "0 STEP %d\n",$z+1);
for ($y = 0; $y<$self->{yradius}; $y++)
{
for ($x = 0; $x<$self->{xradius}; $x++)
{
$a = $self->{steps}->[$z]->[$y]->[$x];
if ($a)
{
$text .= sprintf("1 $color %d %d %d $imatrix $part\n",
$x*20, -$z*8, $y*20);
}
}
}
}
return $text;
}
# Various point-in-sphere rules selected by $rule parameter
#
# Rule 0 makes a spheroid
# Rule 4 makes a cone
# Rule 8 makes a "tentoid"
# The last few bits of the rule number are the stud inclusion rule
# +1 test center base of plate for inclusion
# +2 test center base of stud (top of plate) for inclusion
# +3 test center top of stud for inclusion
# +0 is the same as +1
sub InsideTest
{
my ($self, $rule, $x, $y, $z) = @_;
my ($v);
# exponent functions:
sub sq { return $_[0] * $_[0]; }
sub hy { return $_[0] ^ 0.50; }
my $zrule = ($rule & 0x3);
my $mainrule = $rule - $zrule;
my $zadd = [ 0, 0, 1, 1.64 ] -> [$zrule];
# rule 0: spheroid
if ($mainrule == 0)
{
$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius}) +
sq(($z+$zadd)/$self->{height});
return $v < 1.0;
}
# rule 4: cone
elsif ($mainrule == 4)
{
$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius});
return $v < sq(1.0 - ($z+$zadd)/$self->{height});
}
# rule 8: tent
elsif ($mainrule == 8)
{
$v = sq(($x+0.5)/$self->{xradius}) + sq(($y+0.5)/$self->{yradius});
return $v < sq(1.0 - sqrt( ($z+$zadd)/$self->{height}) );
}
else { die "InsideTest rule $rule not a known rule"; }
}
|
|
Message is in Reply To:
 | | Spheroid Generator (Perl) makes DAT
|
| Hi all, I've got a Perl program to generate spheres and other shapes in LDRAW format, or as crude ASCII instruction steps. I wrote this to assist in creating my 16x16 dome out of plates. The program is free. You will need to have beginner Perl (...) (22 years ago, 15-Jul-02, to lugnet.cad.dev)
|
9 Messages in This Thread:
 
- Entire Thread on One Page:
- Nested:
All | Brief | Compact | Dots
Linear:
All | Brief | Compact
|
|
|
|
