perl的引用和->

本文详细介绍了Perl语言中的引用概念,包括标量变量、数组、哈希变量等数据类型的引用定义及实例。通过具体示例展示了如何创建和使用数组及哈希的引用,并解释了在子程序中传递引用的优势。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

常见数据类型的引用定义:

数据类型           定义      举例

标量变量           \$Var                              $Pointer  =  \$Var

数组                 \@Array                          $Pointer  =  \@Array

哈希变量           \%Hash                           $Pointer  =  \%Hash

文件句柄           \*FILEHANDLE                $Pointer  =  \

常量                 \常量                               $Pointer  =  \3.1415926

子程序              \&SubRoutine                  $Pointer  =  \&SubRoutine

匿名数组            [ LIST ]                            $Pointer  =  [ “Smith”,“Jack”,“Jimmy”,“ZhaZha”]

匿名哈希变量     { Key=>Value }                $Pointer  = { Key1=>Value1,Key2=>Value2}

匿名子程序        sub {}                               $Pointer  =  sub { printf( “Hello,Perl World\n”);}

对象引用           bless  $self;

 


翻译自:
http://www.thegeekstuff.com/2010/06/perl-array-reference-examples/
http://www.thegeekstuff.com/2010/06/perl-hash-reference/


reference是另一个变量的地址。reference可以指向array,hash,或perl代码段。reference使perl代码运行更快。

一 array的reference和dereference

 

1)array的reference
正常地,我们存储list的元素在array中如下:@array =  (“one”,”two”,”three”,”four”,”five”);
使用\来将array的地址赋给reference变量,如下:$array_ref = \@array;
如果你print $array_ref,将显示如下:ARRAY(0x1a2b3c);
array的reference可以被传递给subroutine,如下:
sub add_numbers
{
  my $array_ref =  shift;
  .....
}  

@numbers = (11,2,3,45);

$array_ref = add_numbers(\@numbers);
在以上的代码中,我们需要对array的reference进行dereference,然后才可以使用array中的元素。

下面是传递array的reference到subroutine的优点:
* 如果array传递给subroutine,perl将整个array重新copy到@_中,当array比较大时,这将非常的低效。
* 当我们需要在subroutine中修改原来的array的时候,我们需要传递array的reference。
* reference其实是构造复杂数据结构的本质。

我们也可以将匿名的array赋给reference如下:$array_ref = [ 11,2,3,45]

2)array的reference的dereference
在subroutine中,我们可以使用如下的方法来dereference array的reference:@{ $array_ref };
取得第一个元素如下:$ { $array_ref }[0];
或者可以使用perl的特殊符号来使用array的reference,如下:
# Get all the elements of @numbers array.
@ { $_[0] }

# Get a particular element. This gives the first element of the array.
$ { $_[0] } [0]

注意,如果只是dereference一个简单的scalar变量,可以忽略括号,如下:
@$array_ref  # same as @{ $array_ref }

$$array_ref  # same as $ { $array_ref }

$_[0]         # not a simple scalar variable and this cant be dereferenced,


二 hash的reference和dereference

hash的reference和dereference与array的一样。

hash的reference如下:
%author = (
'name'              => "Harsha",
'designation'      => "Manager"
);

$hash_ref = \%author;

dereference后访问元素如下:
$name = $ { $hash_ref} { name }; 等价于 my $name =  $hash_ref->{name};

访问所有的keys如下:
my @keys = keys % { $hash_ref }; 等价于my @keys = keys %author;

如果是简单scalar变量,可以忽略括号,如下:my @keys =  keys  %$hash_ref; $name = $$hash_ref{name};

匿名hash的reference如下:
my $hash_ref  =  {
'name'               => "Harsha",
'designation'       => "Manager"
};

使用如下:$name = $ { $hash_ref} { name };

三 对reference变量使用-> 来获得属性

my $name =  $hash_ref->{name};


完!

 

 

#!/usr/bin/perl -w ##########################程式信息########################## #脚本名称:防焊开窗优化程式(solder_dfm.pl) #开发人员:欣强电子电脑室(唐伟) #开发时间:2017年8月1日 #版本信息:Ver_A.1.0 (A:制前规则变更,外部变更或升级;1.0:脚本基带版本号,内部变更或升级) #修改信息:当前版本(Ver_A.1.0),首次开发测试,暂无版本变更信息 ##########################程式信息########################## ##########################提示代码########################## my $panel_bp_101 = "错误代码:101,当前用户没有执行权限,请联系系统管理员!"; my $panel_bp_102 = "错误代码:102,请打开料号后再执行程式!"; my $panel_bp_103 = "错误代码:103,请在打开Step再执行程式!"; my $panel_bp_104 = "错误代码:104,参数不可有空数值!"; my $panel_bp_105 = "错误代码:105,请选择当前料号的工作层!"; my $panel_bp_106 = "错误代码:106,请选择对比料号的对比层!"; my $panel_bp_107 = "错误代码:107,对比料号Step没有创建profile,无法执行profile范围比对!"; my $panel_bp_108 = "错误代码:108,脚本注册失败,无法获取系统管理员权限!"; ##########################提示代码########################## #库及包的调取 use lib "$ENV{GENESIS_DIR}/$ENV{GENESIS_EDIR}/all/perl"; use Genesis; use Tk; use Tk::Tree; use Tk::PNG; use Tk::Bitmap; use Tk::LabFrame; use Tk::LabEntry; use strict; use Encode; use encoding 'utf-8'; use Date::Calc qw(Delta_Days); use POSIX qw(strftime); use warnings; use Time::Piece; use Date::Calc qw(Delta_Days); require 'shellwords.pl'; ##########################初始化########################## my $f = new Genesis; #new my $version = 'A.1.0(测试版)'; #定义版本号 #获取系统时间 my $date = strftime("%Y年%m月%d日",localtime()); #日期(年--日) my $time = strftime("%H时%M分%S秒", localtime(time)); #时间(时--秒) #获取当前系统,主机名,用户组,用户名 my $Sys_name = &GetUserSymtem(); #系统名 my $Hostname = $ENV{HOST}; #主机名 my $User_group = &GetUserGroup(); #用户组 my $Username = &GetUserName(); #用户名 my $User_prive = &GetUserPrive(); #用户权限 #获取当前工作软件环境(默认获取Incam环境变量) my $Soft_path = $ENV{INCAM_PRODUCT}; #获取当前工作料号及step my $JOB = $ENV{JOB}; #料号 my $STEP = $ENV{STEP}; #Step ##########################初始化########################## #tk界面 my $mw = MainWindow->new(-background => "#CDD2E4"); my ($lVer,$Font,$ImgPath); $ImgPath = "$ENV{GENESIS_DIR}/sys/scripts/solder/icon"; chomp($ImgPath); if ($Sys_name =~ /Win/) { #系统权限 $lVer = "Windows"; $Font = "楷体 10"; } elsif ($Sys_name =~ /Linux/) { #获取系统名 $lVer = `cat /etc/issue | head -n 1`; chomp($lVer); $Font = "Ukai 10"; } else { $lVer = "Other OS"; $Font = "SimSun 10"; } if ($User_prive <= 10) { $mw->withdraw; &MessageDialogWarn("$panel_bp_101"); exit(0); } unless ($JOB) { #料号下执行权限 $mw->withdraw; &MessageDialogWarn("$panel_bp_102"); exit(0); } unless ($STEP) { #料号Step下执行权限 $mw->withdraw; &MessageDialogWarn("$panel_bp_103"); exit(0); } ##########################权限控制######################### #######################定义全局变量######################### my $Job_Path; #获取料号路径 if (defined $Soft_path) { $Job_Path = $f->COM("get_job_path,job=$JOB"); #InCAM } else { $Job_Path = `$ENV{GENESIS_DIR}/e$ENV{GENESIS_VER}/misc/dbutil path jobs $JOB`;chomp $Job_Path; #Genesis2000 } my $next_code = "iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAACXBIWXMAAAsSAAALEgHS3X78AAAANklEQVQokWNgGAjwn4GBwZpUDSRp+s9Aoqb/DHg0MeLQgA7g6piIsNGGFCeR5AeSQomkeMALAJpZEs3h4b2/AAAAAElFTkSuQmCC"; my $Week = localtime->week; # my $images_path = "$ImgPath/icon"; # my ($tmopt,$gxopt,$Smdopt,$lbcyjz) = (1,2,2,2); #初始参数 my ($tmopt,$gxopt,$Smdopt,$lbcyjz) = (0.2,2,2.5,2); #初始参数 my $do_type = 'type_auto1'; my $l_message = undef; my $message = ""; my $mess = ""; my $event_id = undef; my ($Smd_opt_ftsz,$Cov_opt_ftsz,$Suf_opt_ftsz,$Suf_opt_yjsz,$jdzs,$jdzsjdz); #######################定义全局变量######################### ##########################料号数据######################### $f->DO_INFO("-t MATRIX -d ROW -e $JOB/matrix"); my ($info_ref,@maska,@signa,@mask,@sign); for (my $i = 0 ; $i < @{$f->{doinfo}{gROWname}} ; $i++) { $info_ref = { name => @{$f->{doinfo}{gROWname}}[$i], layer_type => @{$f->{doinfo}{gROWlayer_type}}[$i], context => @{$f->{doinfo}{gROWcontext}}[$i], polarity => @{$f->{doinfo}{gROWpolarity}}[$i], side => @{$f->{doinfo}{gROWside}}[$i], }; if ($info_ref->{context} eq "board" && $info_ref->{layer_type} eq "solder_mask" ) { push(@maska,$info_ref->{name}); } elsif ($info_ref->{context} eq "board" && $info_ref->{layer_type} eq "signal" && ($info_ref->{side} eq "top" || $info_ref->{side} eq "bottom")) { push(@signa,$info_ref->{name}); } } ##########################料号数据######################### ##################### #主窗口设置 my $logo1 = $mw->Photo(-format => 'png',-file => "$ImgPath/twei_logo.png"); my $logo2 = $mw->Photo(-format => 'png',-file => "$ImgPath/solder_dfm.png"); my $logo3 = $mw->Photo(-format => 'png',-file => "$ImgPath/ncc.png"); my $gwidth = 635; my $gheight = 350; if ($Sys_name =~ /Linux/) { $gheight = 380; } my $px = int(($mw->screenwidth() - $gwidth) / 2); my $py = int(($mw->screenheight() - $gheight - 20) / 2); $mw->geometry("${gwidth}x${gheight}+$px+$py"); $mw->resizable(0,0); $mw->bind("Escape", sub{exit}); $mw->title("防焊墓碑优化程式(开源免费无限制)"." 版本:$version --BpSystem"); # $mw->iconbitmap("$ImgPath/ncc.ico"); if ($Sys_name =~ /Linux/) { $mw->iconimage($logo3); } else { $mw->iconbitmap("$ImgPath/ncc.ico"); } my $LabelFrame = $mw->Frame( -relief => 'ridge', -background => "#CDD2E4", ) ->pack(-fill => 'x'); my $LabelLogo1 = $LabelFrame->Label( -image => $logo1, -anchor => 'w', -bg => "#CDD2E4", )->pack(-side => "left",-expand => 1); my $LabelText2 = $LabelFrame->Label( -text => " 开源时间:2019-12-17\n开发人员:一阵寒风\n微信号码:358143105", -bg => "#CDD2E4", -font => $Font, -fg => "#2f4f4f")->pack(-side => "left",-expand => 1); my $LabelLogo3 = $LabelFrame->Label( -image => $logo2, -anchor => 'w', -bg => "#CDD2E4" )->pack(-side => "left",-expand => 1); my $msgbar = $mw->Label( -borderwidth => 2, -relief => 'ridge', -bg => "#CDD2E4" )->pack(-side => 'top', -fill => 'x'); my $messbs = " 当前主机:$Hostname 用户组:$User_group 用户名:$Username 用户权限:$User_prive "; my $event_idmse = undef; $msgbar->Label( -textvariable => \$messbs, -font=>$Font, -bg => "#CDD2E4" )->pack(-fill => 'x'); $event_idmse = $mw->repeat(300, \&scroll); my $FrameMain = $mw->LabFrame( -label=>'参数调整区:', -foreground => "red", -font => $Font, -borderwidth => 2, -relief => 'ridge', -background => "#CDD2E4", ) ->pack(-fill => 'both'); my $SubFrameMain = $FrameMain->Frame(-background => "#CDD2E4",) ->pack(-fill => 'both'); ###################################################################################### my $SubFrameL = $SubFrameMain->LabFrame( -label=>'运行级别:', -foreground => "red", -font => $Font, -borderwidth => 2, -relief => 'ridge', -background => "#CDD2E4", ) ->pack(-fill => 'both'); my $main = $SubFrameL->Frame(-bg => "#CDD2E4",)->pack(-side => "top",-fill => 'both',-expand => 1); my $optionFrame = $main->Frame(-bg => "#CDD2E4",)->pack(-fill => 'both',-expand => 1); my $sle = $optionFrame->Radiobutton( -background => "#CDD2E4", -text => "整板制作", -font => $Font, -value => 'type_auto1', -variable => \$do_type, )->pack(-side=>'left',-expand => 1); my $i = 0; while ($i < scalar(@maska)) { $f->INFO(entity_type => 'layer',entity_path => "$JOB/$STEP/$maska[$i]"); if ($f->{doinfo}{gSIDE} eq "top") { my $sle1 = $optionFrame->Radiobutton( -background => "#CDD2E4", -text => "顶层制作", -font => $Font, -value => 'type_auto2', -variable => \$do_type, )->pack(-side=>'left',-expand => 1); my $sle2 = $optionFrame->Radiobutton( -background => "#CDD2E4", -text => "顶层自选", -font => $Font, -value => 'type_auto3', -variable => \$do_type, )->pack(-side=>'left',-expand => 1); } else { my $sle1 = $optionFrame->Radiobutton( -background => "#CDD2E4", -text => "底层制作", -font => $Font, -value => 'type_auto4', -variable => \$do_type, )->pack(-side=>'left',-expand => 1); my $sle2 = $optionFrame->Radiobutton( -background => "#CDD2E4", -text => "底层自选", -font => $Font, -value => 'type_auto5', -variable => \$do_type, )->pack(-side=>'left',-expand => 1); } $i++ } my $select_frm = $SubFrameMain->LabFrame( -label =>"参数设置:单位(mil),均为单边数值,自行调整最优的参数,\"()\"内为推荐参数范围", -borderwidth => 2, -background => "#CDD2E4", -fg => "red", -relief => 'ridge', -font => $Font, )->pack(-side=>'top',-fill=>'both'); my $show_check = $select_frm->Frame( -background => "#CDD2E4", -borderwidth =>2, -height => 20, )->pack(-side=>'top',-fill=>'both'); my $thick_board = $show_check->LabEntry( -label => '铜面SMD开窗值(0/1.0):', -labelBackground => '#CDD2E4', -labelFont => $Font, -textvariable => \$tmopt, -bg => 'white', -width => 15, -relief=>'ridge', -state=>"normal", -labelPack => [qw/-side left -anchor w/], )-> grid(-row => '0', -column => '0'); my $update = $show_check->LabEntry( -label => 'SMD最小盖线值(0/2.0):', -labelBackground => '#CDD2E4', -labelFont => $Font, -textvariable => \$gxopt, -bg => 'white', -width => 15, -relief=>'ridge', -state=>"normal", -labelPack => [qw/-side left -anchor w/], )-> grid(-row => '1', -column => '0'); my $updated = $show_check->Label(-text => ' ',-bg =>'#CDD2E4')->grid(-row => '0', -column => '1'); my $updatee = $show_check->Label(-text => ' ',-bg =>'#CDD2E4')->grid(-row => '1', -column => '1'); my $updats = $show_check->LabEntry( -label => '标准SMD开窗值(2/3.0):', -labelBackground => '#CDD2E4', -labelFont => $Font, -textvariable => \$Smdopt, -bg => 'white', -width => 15, -relief=>'ridge', -state=>"normal", -labelPack => [qw/-side left -anchor w/], )-> grid(-row => '0', -column => '2'); my $updath = $show_check->LabEntry( -label => 'SMD接铜圆角值(0/2.0):', -labelBackground => '#CDD2E4', -labelFont => $Font, -textvariable => \$lbcyjz, -bg => 'white', -width => 15, -relief=>'ridge', -state=>"normal", -labelPack => [qw/-side left -anchor w/], )-> grid(-row => '1', -column => '2'); my $button_frm = $mw->Frame(-background => "#CDD2E4",-borderwidth =>10,-height => 20)->pack(-anchor=>'e',-fill=>'both'); my $create_button = $button_frm->Button( -text => '执行', -command => sub {&appy}, -width => 8, -bg=>'#A1AEE1', -font=> $Font, -height=> 1, )->pack(-side=>'left',-expand => 1,); my $exit_button = $button_frm->Button( -text => '取消', -command => sub {exit;}, -width => 8, -bg=>'#A1AEE1', -font=> $Font, -height=> 1, )->pack(-side=>'left',-expand => 1,); my $help_button = $button_frm->Button( -text => '帮助', -command => \&helps, -width => 8, -bg=>'#A1AEE1', -font=> $Font, -height=> 1, )->pack(-side=>'left',-expand => 1,); ###################################################################################### my $msgarea = $mw->Label(-borderwidth => 2, -relief => 'ridge',-bg => "#7B7E89",-font=>$Font)->pack(-side => 'bottom', -fill => 'x'); my $next = $mw->Photo(-data=>$next_code, -format=>'png'); $msgarea->Label(-image=>$next,-bg => "white")->pack(-side=>'left',-expand => 1); $msgarea->Label(-textvariable => \$mess,-font=>$Font,-bg => "#7B7E89",-fg => "white")->pack(-side =>'left',-expand => 1); $event_id = $mw->repeat(300, \&timeout); MainLoop; #主程序 sub appy { if (scalar(@maska) == 2) { if ($do_type eq 'type_auto1') { @mask = @maska; @sign = @signa; } elsif ($do_type eq 'type_auto2' or $do_type eq 'type_auto3') { @mask = ($maska[0]); @sign = ($signa[0]); } elsif ($do_type eq 'type_auto4' or $do_type eq 'type_auto5') { @mask = ($maska[1]); @sign = ($signa[1]); } } elsif (scalar(@maska) == 1) { if ($do_type eq 'type_auto1') { @mask = @maska; $f->INFO(entity_type => 'layer',entity_path => "$JOB/$STEP/$maska[0]"); my $cjx = $f->{doinfo}{gSIDE}; foreach my $a(@signa) { $f->INFO(entity_type => 'layer',entity_path => "$JOB/$STEP/$a"); if ($f->{doinfo}{gSIDE} eq $cjx) { @sign = ($a); } } } elsif ($do_type eq 'type_auto2' or $do_type eq 'type_auto3') { @mask = @maska; foreach my $b(@signa) { $f->INFO(entity_type => 'layer',entity_path => "$JOB/$STEP/$b"); if ($f->{doinfo}{gSIDE} eq "top") { @sign = ($b); } } } elsif ($do_type eq 'type_auto4' or $do_type eq 'type_auto5') { @mask = @maska; foreach my $c(@signa) { $f->INFO(entity_type => 'layer',entity_path => "$JOB/$STEP/$c"); if ($f->{doinfo}{gSIDE} eq "bottom") { @sign = ($c); } } } } if ($tmopt eq "" || $gxopt eq "" || $Smdopt eq "" || $lbcyjz eq "") { &MessageDialogWarn("$panel_bp_104"); return; } $mw->iconify; $Smd_opt_ftsz = $Smdopt*2 + 1.2; $Cov_opt_ftsz = $gxopt*2 + 0.15; $Suf_opt_ftsz = $tmopt*2 - 0.1; $Suf_opt_yjsz = $tmopt*1; $f->COM ("units,type=inch"); my $a = 0; while ($a < scalar(@mask)) { &ClearLayer(); $f->VOF; &WorkLayer("$mask[$a].bk"); $f->COM ("sel_delete"); $f->VON; &DelectLay( "$mask[$a].tmp", "$mask[$a].tmps", "$mask[$a].tmpp", "$mask[$a].tmppt", "$mask[$a].tmppd", "$mask[$a].tmpos", "$mask[$a].ds", "$mask[$a].tmppp", "$mask[$a].tmpppd", "$mask[$a].tmppp+++", "$mask[$a].smd", "$mask[$a].smds" ); &WorkLayer("$mask[$a]"); &CopyLay("$mask[$a].bk","no",0); &WorkLayer("$sign[$a]"); my $selcct_fe; if ($do_type eq 'type_auto1' or $do_type eq 'type_auto2' or $do_type eq 'type_auto4') { $selcct_fe = &SelAttCopy(".smd",0,0); } elsif ($do_type eq 'type_auto3' or $do_type eq 'type_auto5') { &do_arec; last; } if ($selcct_fe != 0){ &CopyLay("$mask[$a].tmp","no",0); &WorkLayer("$mask[$a].tmp"); &CopyLay("$mask[$a].tmpp","no",0); &CopyLay("$mask[$a].smd","no",0); } else { last; } &WorkLayer("$sign[$a]"); &CopyLay("$mask[$a].tmppp","no",0); &WorkLayer("$mask[$a].tmpp"); if ($tmopt <= 0) { $jdzs = ($tmopt + $gxopt) * 2; $jdzsjdz = abs($jdzs); } else { $jdzs = 0.1; $jdzsjdz = 0; } &CopyLay("$mask[$a].tmppp","yes",$jdzs); &WorkLayer("$mask[$a].tmppp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=$Cov_opt_ftsz,corner_ctl=no"); &WorkLayer("$mask[$a].tmpp"); &CopyLay("$mask[$a].tmppp","yes",$Suf_opt_ftsz); &WorkLayer("$mask[$a].tmppp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=-1.5,corner_ctl=no"); &CopyLay("$mask[$a].tmpppd","no",0); $f->COM ("sel_surf2outline,width=1.5"); &WorkLayer("$mask[$a].tmpppd"); &CopyLay("$mask[$a].tmppp","no",0); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_resize,size=$Smd_opt_ftsz,corner_ctl=no"); &CopyLay("$mask[$a].tmppt","no",0); &WorkLayer("$mask[$a].tmppp"); &CopyLay("$mask[$a].tmpp","yes",0); &CopyLay("$mask[$a].tmppt","yes",10); &WorkLayer("$mask[$a].tmppt"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &CopyLay("$mask[$a].tmpp","no",0); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=-$lbcyjz,corner_ctl=no"); &CopyLay("$mask[$a].tmppd","no",0); $f->COM ("sel_surf2outline,width=$lbcyjz"); &WorkLayer("$mask[$a].tmppd"); &CopyLay("$mask[$a].tmpp","no",0); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].tmpp"); $f->COM ("fill_params,type=solid,origin_type=datum,solid_type=fill,std_type=line,min_brush=2,use_arcs=yes,symbol=,dx=0.1,dy=0.1,std_angle=45,std_line_width=10,std_step_dist=50,std_indent=odd,break_partial=yes,cut_prims=no,outline_draw=no,outline_width=0,outline_invert=no"); $f->COM ("sel_fill"); $f->COM ("sel_contourize,accuracy=0.1,break_to_islands=yes,clean_hole_size=3,clean_hole_mode=x_and_y"); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_resize,size=-0.5,corner_ctl=no"); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_ref_feat,layers=$mask[$a].tmp,use=filter,mode=disjoint,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com3 = $f->{COMANS}; if ($selcct_com3 != 0){ $f->COM ("sel_delete"); } $f->COM ("sel_ref_feat,layers=$mask[$a].tmp,use=filter,mode=cover,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com2 = $f->{COMANS}; if ($selcct_com2 != 0){ $f->COM ("sel_delete"); } &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_resize,size=$Smd_opt_ftsz,corner_ctl=no"); &CopyLay("$mask[$a].tmpos","no",-$lbcyjz); $f->COM ("sel_resize,size=-$lbcyjz,corner_ctl=no"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_surf2outline,width=$lbcyjz"); &WorkLayer("$mask[$a].tmpos"); &CopyLay("$mask[$a].tmp","no",0); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].tmpp"); &CopyLay("$mask[$a].tmp","yes",0.5); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=0.4,corner_ctl=no"); &WorkLayer("$mask[$a]"); &CopyLay("$mask[$a].ds","no",0); &WorkLayer("$mask[$a].ds"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].smd"); $f->COM ("sel_resize,size=$tmopt,corner_ctl=no"); $f->COM ("sel_resize,size=$Suf_opt_yjsz,corner_ctl=no"); &CopyLay("$mask[$a].smds","no",-1); $f->COM ("sel_resize,size=-1,corner_ctl=no"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_surf2outline,width=1"); &WorkLayer("$mask[$a].smds"); &CopyLay("$mask[$a].smd","no",0); &WorkLayer("$mask[$a].smd"); &CopyLay("$mask[$a].tmp","yes",0); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("cur_atr_reset"); $f->COM ("cur_atr_set,attribute=.solder_defined"); $f->COM ("sel_change_atr,mode=add"); $f->COM ("cur_atr_reset"); $f->COM ("sel_ref_feat,layers=$mask[$a].ds,use=filter,mode=disjoint,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com1 = $f->{COMANS}; if ($selcct_com1 != 0){ $f->COM ("sel_delete"); } $f->COM ("sel_ref_feat,layers=$mask[$a].ds,use=filter,mode=cover,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); $f->COM ("get_select_count"); my $selcct_com = $f->{COMANS}; if ($selcct_com != 0){ $f->COM ("sel_delete"); } &CopyLay("$mask[$a]","yes",0); $f->COM ("display_layer,name=$mask[$a].bk,display=yes,number=1"); $f->COM ("display_layer,name=$mask[$a],display=yes,number=2"); $f->COM ("work_layer,name=$mask[$a]"); &DelectLay( "$mask[$a].tmp", "$mask[$a].tmps", "$mask[$a].tmpp", "$mask[$a].tmppt", "$mask[$a].tmppd", "$mask[$a].tmpos", "$mask[$a].ds", "$mask[$a].tmppp", "$mask[$a].tmpppd", "$mask[$a].tmppp+++", "$mask[$a].smd", "$mask[$a].smds" ); $a++ } $mw->withdraw; &MessageDialoginfo("脚本运行完成,请认真核对备份层!"); exit; } sub do_arec { while (1) { $f->COM ("filter_reset,filter_name=popup"); $f->COM ("sel_clear_feat"); $f->COM ("clear_highlight"); $f->COM ("filter_set,filter_name=popup,update_popup=yes,feat_types=pad"); $f->COM ("filter_atr_set,filter_name=popup,condition=yes,attribute=.smd"); $f->COM ("filter_highlight"); $f->COM ("display_layer,name=$mask[$a],display=yes,number=2"); $f->MOUSE("r Please SELECT weizhi"); my @MOUSEANS=$f->{MOUSEANS}; my ($x1,$y1,$x2,$y2)=split /\s+/,$f->{MOUSEANS}; $f->COM("filter_area_strt"); $f->COM("filter_area_xy,x=$x1,y=$y1"); $f->COM("filter_area_xy,x=$x2,y=$y2"); $f->COM("filter_area_end,layer=,filter_name=popup,operation=select,area_type=rectangle,inside_area=yes,intersect_area=no"); $f->COM ("get_select_count"); my $selcct_fea = $f->{COMANS}; if ($selcct_fea != 0) { &CopyLay("$mask[$a].tmp","no",0); &WorkLayer("$mask[$a].tmp"); &CopyLay("$mask[$a].tmpp","no",0); &CopyLay("$mask[$a].smd","no",0); } else { $f->COM ("clear_highlight"); $f->COM ("filter_reset,filter_name=popup"); last; } &WorkLayer("$sign[$a]"); $f->COM("filter_reset,filter_name=popup"); $f->COM("filter_area_strt"); $f->COM("filter_area_xy,x=$x1,y=$y1"); $f->COM("filter_area_xy,x=$x2,y=$y2"); $f->COM("filter_area_end,layer=,filter_name=popup,operation=select,area_type=rectangle,inside_area=yes,intersect_area=yes"); &CopyLay("$mask[$a].tmppp","no",0); &WorkLayer("$mask[$a].tmpp"); if ($tmopt <= 0) { $jdzs = ($tmopt + $gxopt) * 2; $jdzsjdz = abs($jdzs); } else { $jdzs = 0.1; $jdzsjdz = 0; } &CopyLay("$mask[$a].tmppp","yes",$jdzs); &WorkLayer("$mask[$a].tmppp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=$Cov_opt_ftsz,corner_ctl=no"); &WorkLayer("$mask[$a].tmpp"); &CopyLay("$mask[$a].tmppp","yes",$Suf_opt_ftsz); &WorkLayer("$mask[$a].tmppp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=-1.5,corner_ctl=no"); &CopyLay("$mask[$a].tmpppd","no",0); $f->COM ("sel_surf2outline,width=1.5"); &WorkLayer("$mask[$a].tmpppd"); &CopyLay("$mask[$a].tmppp","no",0); $f->COM ("display_layer,name=$mask[$a].tmpp,display=yes,number=1"); $f->COM ("work_layer,name=$mask[$a].tmpp"); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_resize,size=$Smd_opt_ftsz,corner_ctl=no"); &CopyLay("$mask[$a].tmppt","no",0); &WorkLayer("$mask[$a].tmppp"); &CopyLay("$mask[$a].tmpp","yes",0); &CopyLay("$mask[$a].tmppt","yes",10); &WorkLayer("$mask[$a].tmppt"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &CopyLay("$mask[$a].tmpp","no",0); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=-$lbcyjz,corner_ctl=no"); &CopyLay("$mask[$a].tmppd","no",0); $f->COM ("sel_surf2outline,width=$lbcyjz"); &WorkLayer("$mask[$a].tmppd"); &CopyLay("$mask[$a].tmpp","no",0); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].tmpp"); $f->COM ("fill_params,type=solid,origin_type=datum,solid_type=fill,std_type=line,min_brush=2,use_arcs=yes,symbol=,dx=0.1,dy=0.1,std_angle=45,std_line_width=10,std_step_dist=50,std_indent=odd,break_partial=yes,cut_prims=no,outline_draw=no,outline_width=0,outline_invert=no"); $f->COM ("sel_fill"); $f->COM ("sel_contourize,accuracy=0.1,break_to_islands=yes,clean_hole_size=3,clean_hole_mode=x_and_y"); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_resize,size=-0.5,corner_ctl=no"); &WorkLayer("$mask[$a].tmpp"); $f->COM ("sel_ref_feat,layers=$mask[$a].tmp,use=filter,mode=disjoint,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com3a = $f->{COMANS}; if ($selcct_com3a != 0){ $f->COM ("sel_delete"); } $f->COM ("sel_ref_feat,layers=$mask[$a].tmp,use=filter,mode=cover,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com2a = $f->{COMANS}; if ($selcct_com2a != 0){ $f->COM ("sel_delete"); } &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_resize,size=$Smd_opt_ftsz,corner_ctl=no"); &CopyLay("$mask[$a].tmpos","no",-$lbcyjz); $f->COM ("sel_resize,size=-$lbcyjz,corner_ctl=no"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_surf2outline,width=$lbcyjz"); &WorkLayer("$mask[$a].tmpos"); &CopyLay("$mask[$a].tmp","no",0); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].tmpp"); &CopyLay("$mask[$a].tmp","yes",0.5); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_resize,size=0.4,corner_ctl=no"); &WorkLayer("$mask[$a]"); &CopyLay("$mask[$a].ds","no",0); &WorkLayer("$mask[$a].ds"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); &WorkLayer("$mask[$a].smd"); $f->COM ("sel_resize,size=$tmopt,corner_ctl=no"); $f->COM ("sel_resize,size=$Suf_opt_yjsz,corner_ctl=no"); &CopyLay("$mask[$a].smds","no",-1); $f->COM ("sel_resize,size=-1,corner_ctl=no"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes"); $f->COM ("sel_surf2outline,width=1"); &WorkLayer("$mask[$a].smds"); &CopyLay("$mask[$a].smd","no",0); &WorkLayer("$mask[$a].smd"); &CopyLay("$mask[$a].tmp","yes",0); &WorkLayer("$mask[$a].tmp"); $f->COM ("sel_cont_resize,accuracy=0.1,break_to_islands=yes,island_size=0,hole_size=0,drill_filter=no,corner_ctl=yes "); $f->COM ("cur_atr_reset"); $f->COM ("cur_atr_set,attribute=.solder_defined"); $f->COM ("sel_change_atr,mode=add"); $f->COM ("cur_atr_reset"); $f->COM ("sel_ref_feat,layers=$mask[$a].ds,use=filter,mode=disjoint,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); my $selcct_com1a = $f->{COMANS}; if ($selcct_com1a != 0){ $f->COM ("sel_delete"); } $f->COM ("sel_ref_feat,layers=$mask[$a].ds,use=filter,mode=cover,pads_as=shape,f_types=line\;pad\;surface\;arc\;text,polarity=positive\;negative,include_syms=,exclude_syms="); $f->COM ("get_select_count"); my $selcct_coma = $f->{COMANS}; if ($selcct_coma != 0){ $f->COM ("sel_delete"); } $f->COM ("sel_copy_other,dest=layer_name,target_layer=$mask[$a],invert=yes,dx=0,dy=0,size=0,x_anchor=0,y_anchor=0,rotation=0,mirror=none"); &CopyLay("$mask[$a]","yes",0); $f->COM ("display_layer,name=$sign[$a],display=yes,number=1"); $f->COM ("display_layer,name=$mask[$a],display=yes,number=2"); $f->COM ("work_layer,name=$sign[$a]"); &DelectLay( "$mask[$a].tmp", "$mask[$a].tmps", "$mask[$a].tmpp", "$mask[$a].tmppt", "$mask[$a].tmppd", "$mask[$a].tmpos", "$mask[$a].ds", "$mask[$a].tmppp", "$mask[$a].tmpppd", "$mask[$a].tmppp+++", "$mask[$a].smd", "$mask[$a].smds" ); $f->COM ("clear_highlight"); $f->COM ("filter_reset,filter_name=popup"); } } ##########################函数区########################## sub SelAttCopy { #属性选择 my ($attribute,$text,$option,$tolay,$invert,$size) = @_; $f->COM("filter_reset,filter_name=popup"); $f->COM ("filter_set,filter_name=popup,update_popup=yes,feat_types=pad"); $f->COM("filter_atr_set,filter_name=popup,condition=yes,attribute=$attribute,text=$text,option=$option"); $f->COM("filter_area_strt"); $f->COM("filter_area_end,layer=,filter_name=popup,operation=select,area_type=none,inside_area=no,intersect_area=no"); $f->COM("get_select_count"); my $selShul = $f->{COMANS}; return $selShul; } sub CopyLay { #复制层 my ($target_layer,$invert,$size) = @_; $f->COM("sel_copy_other,dest=layer_name,target_layer=$target_layer,invert=$invert,dx=0,dy=0,size=$size,x_anchor=0,y_anchor=0,rotation=0,mirror=none"); } sub DelectLay { #删除层(接收多个参数) $f->VOF(); foreach(@_){ $f->COM("delete_layer,layer=$_"); } $f->VON(); } sub WorkLayer { #工作层 my $WorkLay = shift; $f->COM("affected_layer,mode=all,affected=no"); $f->COM("clear_layers"); $f->COM("filter_reset,filter_name=popup"); $f->COM("display_layer,name=$WorkLay,display=yes,number=1"); $f->COM("work_layer,name=$WorkLay"); } sub ClearLayer { #层初始化 my $WorkLay = shift; $f->COM("affected_layer,mode=all,affected=no"); $f->COM("clear_layers"); $f->COM("filter_reset,filter_name=popup"); } sub helps { my $mw = MainWindow->new( -title =>"关于脚本",-background => "#CDD2E4"); $mw->geometry("560x680+800+100"); $mw->resizable(0,0); $mw->update; # if ($Sys_name =~ /Linux/) { # $mw->iconimage($logo3); # } else { # $mw->iconbitmap("$ImgPath/ncc.ico"); # } my $helps_log = $mw->Photo('info',-file => "$ImgPath/hp.xpm"); $mw ->Label(-image => $helps_log, -border => 1, -relief => 'solid',)->pack(-side => 'top',-padx => 1,-pady => 1); $mw->Label( -text => "注意事项及免责申明\n". "1.参数设置部分需根据本厂的具体工艺要求合理设置,特殊要求可视情况定制,\n". "2.使用推荐范围内的参数,综合管控及细节处理效果更佳,\n". "3.脚本运行不干涉防焊层,直接以负片的形式做出,请在运行脚本后再做塞孔处理,\n". "4.请认真核对备份层,以免造成未知错误对您产生影响,\n". "5.脚本可以提升效率及品质但不能替代人的作用,可信赖脚本但不可依赖,\n". "6.对于使用本脚本产生任何不良影响脚本制作者无关,\n". "7.如您继续使用此脚本表示您已接受以上所有条款!\n", -font => '宋体 10', -background => "#CDD2E4" )->pack(-side => 'top',); $mw->Label( -text => "技术在于碰撞,欢迎大家批评指教,望大家共同努力共同进步!", -fg => 'blue', -font => '宋体 10', -background => "#CDD2E4", )->pack(-side => 'top',); $mw->Button( -text => '确定',-command => sub {$mw->destroy;}, -width => 8, -font=> '宋体 10', -height=> 1, -background => "#A1AEE1" )->pack(-side => 'right', -padx => 12, -pady => 12); $mw->Label( -text => "\n\n Copyright © 2017 Twei Tang. All rights reserved ", -fg => 'red', -font => '宋体 10', -background => "#CDD2E4", )->pack(-side => 'right',); MainLoop; } sub scroll { $messbs = substr($messbs, 1) . substr($messbs, 0, 1); } sub timeout { $mess = strftime("当前时间: %Y-%m-%d %H:%M:%S 第"."$Week"."周 当前系统: $lVer",localtime()); } sub GetUserSymtem { #获取系统名 my $Sys; if ($^O =~ /linux/) { $Sys = "Linux"; } elsif ($^O =~ /MSWin32/) { $Sys = "Windows"; } else { $Sys = "其它"; } return $Sys; } sub GetUserGroup { #获取用户组 $f->COM('get_user_group'); return $f->{COMANS}; } sub GetUserName { #获取用户名 $f->COM('get_user_name'); return $f->{COMANS}; } sub GetUserPrive { #获取用户权限 $f->COM('get_user_priv'); my @priv = split(/\s+/,$f->{COMANS}); return $priv[0]; } sub MessageDialog { #提示信息窗口 my $title = shift; my $icon = shift; my $type = shift; my $message = shift; $mw->messageBox( -icon => $icon, -message => $message, -title =>$title, ($Sys_name =~ /Linux/) ? (-font => $Font, -background => '#EDECEB', -bg => '#CDD2E4', -wraplength => '7i',-type => $type) : (-type => $type) ); return $type; } sub MessageDialogError { #错误提示窗口 $mw->withdraw; &MessageDialog('错误提示','error','ok',shift); exit; } sub MessageDialogWarn { #警告信息窗口 &MessageDialog('警告信息','error','ok',shift); } sub MessageDialoginfo { #操作信息窗口 &MessageDialog('操作信息','info','ok',shift); } ##########################函数区########################## 注意:这个是使用perl语言的TK GUI写的代码,请你把他变为activeperl TKX GUI的代码,要求实现的功能一模一样,不能添加新的库文件,我懒得添加
最新发布
07-14
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值