%macro lireshp(data,data2,arr=4000,filename=); /* Macro écrite par Patrick BROSSIER (GIP RECLUS) data nom du tableau SAS créé à partir du fichier shp data2 nom du tableau SAS créé à partir du fichier dbf arr nombre maximum de segments par polygone filename nom du filename attribué aupravant au fichier shapefile (.shp), sinon le fichier shapefile sera demandé dans le cours de la macro par une boîte de dialogue Cette macro permet de lire les fichiers «shapefile» (.shp et .dbf) de ArcView. Macros utilisées: %litdou %litint %liredbf %bigint %filename Version du 07/06/05 */ %if &data= or &data2= %then %do;data _null_;put "ERROR: Usage " '25'x "lireshp(data,data2,filename=);";run;%goto fin;%end; %if &filename= %then %do; %let filename=shp; %filename(&filename,old); %end; data _null_; length i1-i4 $4 c1-c8 $8; infile &filename recfm=n unbuf; input i3 $char4. +20 i4 $char4. (i1-i2)(2*$char4.) (c1-c8)(8*$char8.) @@; a=%bigint(i3,4); if a^=9994 then do;put "Error: Ce fichier n'est pas un fichier ArcView"; stop; end; staille=%bigint(i4,4); _taille=staille*2; version=%litint(i1,4); stype=%litint(i2,4); if stype^in(0,1,3,5,8,11,13,15,18,21,23,25,28,31) then do;put "Error: Ce type de fichier n'est pas traité. Type=" stype;end; if stype=0 then do;put "Warning: Fichier de type 0";stop;end; xmi=%litdou(c1,8); ymi=%litdou(c2,8); xma=%litdou(c3,8); yma=%litdou(c4,8); zmi=%litdou(c5,8); zma=%litdou(c6,8); mmi=%litdou(c7,8); mma=%litdou(c8,8); put "Note: Version: " version; put "Note: Raille : " _taille; put "Note: Type : " stype; put "Note: Bounding box : X " xmi 15.5 " ->" xma 15.5; put "Note: : Y " ymi 15.5 " ->" yma 15.5; put "Note: : Z " zmi 15.5 " ->" zma 15.5; put "Note: : M " mmi 15.5 " ->" mma 15.5; type=compress(put(stype,2.)); call symput('type',type); taille=compress(put(staille,15.)); call symput('taille',taille); stop; run; %if &type=1 or &type=3 or &type=8 %then %let tabl=&data(keep=_num_ x y); %else %if &type=5 %then %let tabl=&data(keep=_num_ x y segment); %else %if &type=11 or &type=13 or &type=15 or &type=18 %then %let tabl=tempo1(keep=_num_ x y) tempo2(keep=_num_ z) tempo3(keep=_num_ m); %else %if &type=21 %then %let tabl=&data(keep=_num_ x y m); %else %if &type=23 or &type=25 or &type=28 %then %let tabl=tempo1(keep=_num_ x y m) tempo2(keep=_num_ m); %else %if &type=31 %then %let tabl=tempo1(keep=_num_ x y parttype) tempo2(keep=_num_ z) tempo3(keep=_num_ m); data &tabl; length i1-i3 $4 c1-c4 $8; infile &filename recfm=n unbuf; array numparts nump1-nump&arr; array typparts typp1-typp&arr; input @101; long=50; do while(&taille>long); input (i2 i3 i1) (3*$char4.) @@; _num_=%bigint(i2,4); lon=%bigint(i3,4); type=%litint(i1,4); if type^=&type then do;put "Error: stype= &type.;type=" type;stop;end; long=long+lon+4; %if &type=1 %then %do; input (c1-c2)(2*$char8.) @@; x=%litdou(c1,8); y=%litdou(c2,8); output; %end; %if &type=3 or &type=5 %then %do; input (c1-c4)(4*$char8.) (i2-i3)(2*$char4.) @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpar=%litint(i2,4); if numpar>&arr then do; put "ERROR: Il y a plus de &arr morceaux à vos polygones. NUMPAR=" numpar; stop; end; numpoi=%litint(i3,4); segment=_num_; do i=1 to numpar; input i1 $char4. @@; numparts(i)=%litint(i1,4); end; numparts(i)=numpoi; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output; end; if i^=numpar then do; x=.; y=.; output; end; end; %end; %if &type=8 %then %do; input (c1-c4)(4*$char8.) i2 $char4. @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpoi=%litint(i2,4); do i=1 to numpoi; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output; end; %end; %if &type=11 or &type=21 %then %do; input (c1-c3)(3*$char8.) @@; x=%litdou(c1,8); y=%litdou(c2,8); m=%litdou(c3,8); output; %end; %if &type=23 or &type=25 %then %do; input (c1-c4)(4*$char8.) (i2-i3)(2*$char4.) @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpar=%litint(i2,4); if numpar>&arr then do; put "ERROR: Il y a plus de &arr morceaux à vos polygones. NUMPAR=" numpar; stop; end; numpoi=%litint(i3,4); segment=_num_; do i=1 to numpar; input i1 $char4. @@; numparts(i)=%litint(i1,4); end; numparts(i)=numpoi; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output tempo1; end; if i^=numpar then do; x=.; y=.; output tempo1; end; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input c1 $char8.; m=%litdou(c1,8); output tempo2; end; if i^=numpar then do; m=.; output tempo2; end; end; %end; %if &type=13 or &type=15 %then %do; input (c1-c4)(4*$char8.) (i2-i3)(2*$char4.) @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpar=%litint(i2,4); if numpar>&arr then do; put "ERROR: Il y a plus de &arr morceaux à vos polygones. NUMPAR=" numpar; stop; end; numpoi=%litint(i3,4); segment=_num_; do i=1 to numpar; input i1 $char4. @@; numparts(i)=%litint(i1,4); end; numparts(i)=numpoi; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output tempo1; end; if i^=numpar then do; x=.; y=.; output tempo1; end; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input c1 $char8.; z=%litdou(c1,8); output tempo2; end; if i^=numpar then do; z=.; output tempo2; end; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input c1 $char8.; m=%litdou(c1,8); output tempo2; end; if i^=numpar then do; m=.; output tempo3; end; end; %end; %if &type=18 %then %do; input (c1-c4)(4*$char8.) i2 $char4. @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpoi=%litint(i2,4); do i=1 to numpoi; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output tempo1; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpoi; input c1 $char8.; z=%litdou(c1,8); output tempo2; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpoi; input c1 $char8.; m=%litdou(c1,8); output tempo3; end; %end; %if &type=28 %then %do; input (c1-c4)(4*$char8.) i2 $char4. @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpoi=%litint(i2,4); do i=1 to numpoi; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output tempo1; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpoi; input c1 $char8.; m=%litdou(c1,8); output tempo2; end; %end; %if &type=31 %then %do; input (c1-c4)(4*$char8.) (i2-i3)(2*$char4.) @@; /* box1=%litdou(c1,8); box2=%litdou(c2,8); box3=%litdou(c3,8); box4=%litdou(c4,8); */ numpar=%litint(i2,4); if numpar>&arr then do; put "ERROR: Il y a plus de &arr morceaux à vos polygones. NUMPAR=" numpar; stop; end; numpoi=%litint(i3,4); segment=_num_; do i=1 to numpar; input i1 $char4. @@; numparts(i)=%litint(i1,4); end; numparts(i)=numpoi; do i=1 to numpar; input i1 $char4. @@; typparts(i)=%litint(i1,4); end; do i=1 to numpar; parttype=typparts(i); do j=numparts(i) to numparts(i+1)-1; input (c1-c2)(2*$char8.); x=%litdou(c1,8); y=%litdou(c2,8); output tempo1; end; if i^=numpar then do; x=.; y=.; output tempo1; end; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input c1 $char8.; z=%litdou(c1,8); output tempo2; end; if i^=numpar then do; z=.; output tempo2; end; end; input (c1-c2)(2*$char8.) @@; do i=1 to numpar; do j=numparts(i) to numparts(i+1)-1; input c1 $char8.; m=%litdou(c1,8); output tempo2; end; if i^=numpar then do; m=.; output tempo3; end; end; %end; end; stop; run; %if &type=11 or &type=13 or &type=15 or &type=18 or &type=31 %then %do;data &data;merge tempo1 tempo2 tempo3;by _num_;run;%end;%else %if &type=23 or &type=25 or &type=28 %then %do;data &data;merge tempo1 tempo2;by _num_;run;%end; %let nom=%sysfunc(pathname(&filename)); %let i=%index(&nom,.shp)-1; %if &i<0 %then %do;%put ERROR: Le fichier shape '&nom' n a pas un nom correct;%goto fin;%end; %let nom=%substr(&nom,1,&i).dbf; %if ^%sysfunc(fileexist(&nom)) %then %do;%put ERROR: Le fichier dbf &nom est introuvable;%goto fin;%end; filename dbf "&nom"; %liredbf(&data2,filename=dbf); data &data2;set &data2; _num_=_N_; run; proc contents data=&data2;run; %fin:%mend;