IvanAriel

Hi everyone, I updated my old VW 11.5 to VW 2008, but I have a few problems with my old scripts. I was wondering if someone can give me a hand with this issue. Basically the script connects two groups of red polygons. It works perfect in VW 11.5 but now I cannot figure out why it doesn't work. Here is the script: Procedure Join_Groups; {debug} {reunit poligons rouges de 2 groupes, les reordone et fait un group general } VAR x,y: REAL; h,h1,h2,h3, hl: HANDLE; P1,P2,P3: POINT; n,i: INTEGER; r, g, b :LONGINT; f: BOOLEAN; BEGIN DSelectAll; While h=Nil DO BEGIN GetPt(x,y); h:=PickObject(x,y); END; hl := FInGroup(h); WHILE hl <> NIL DO BEGIN GetPenFore(hl,r,g,b); RGBToColorIndex(r,g,b,i); IF i=7 THEN h1:=hl; hl :=NextObj(hl); END; n:=GetVertNum(h1); GetPolyPt(h1,n,P1.x,P1.y); While h2=Nil DO BEGIN GetPt(x,y); h2:=PickObject(x,y); END; hl:= FInGroup(h2); GetPenFore(hl,r,g,b); RGBToColorIndex(r,g,b,i); WHILE i<>7 DO BEGIN hl :=NextObj(hl); GetPenFore(hl,r,g,b); RGBToColorIndex(r,g,b,i); END; GetPolyPt(hl,1,P2.x,P2.y); OpenPoly; BeginPoly; P3:=P1+( (P2-P1)/2); AddPoint(P1.x,P1.y); AddPoint(P3.x,P3.y); AddPoint(P2.x,P2.y); EndPoly; h3:= LnewObj; ColorIndexToRGB(6, r, g, b); SetPenFore(h3, r, g, b); HMoveForward (h,true); SetSelect(h); Hungroup(h); HMoveForward (h3,true); SetSelect(h3); HMoveForward (h2,true); SetSelect(h2); Hungroup(h2); Group; END; RUN (Join_Groups); Thanks in advance!!! Ivan

Hi Charles, Again.... thank you very much for your help. The Script is working!!. Thank you!! Ivan

Hi Charles, Could you help me one more time? I am working with polygons of 4 colours (red, blue, yellow and green) and the script palette of 4 colours. When I click on the red (in the palette) selects all polygons red, and so in this way with the other colours. My question is: in the same way that I work with the colours, how I can select the odd polys and the pairs polys using the script pallet? The function is the same that the other script, but in this case I do not need join them, just select them (odd and pairs) Script: Blue: DSelectAll; SelectObj((PF=4)); Red: DSelectAll; SelectObj((PF=7)); Yellow:DSelectAll; SelectObj((PF=5)); Green:DSelectAll; SelectObj((PF=6)); Thank in advance

Hi ccroft, thank so much for you help, the script is working perfect!!. I have been trying to do this for 2 weeks...and nothing.. Thank you again Charles. Ivan

Hi, thank islandmon and ccroft for reply my question. ccroft, you are right, I can select objects 1,3,5 and then join them, but the problem is that I work between 700 and 1000 polys. At the moment I am selecting poly 1,3,5 to 700...this job take me around 3 or 4 hours. This is the reason because I want to change the script..select all of them and then only join objects 1,3,5,7.. You can see how it works, drawing a few polys, select all, click "Alternate Line" and click in the right or left side of the polys. Please let me know if I am clear with this script. Thank you again for your time

Hi everyone! This is my first post, I have been this script for several time. Basically this script does is to join a set of Polys consecutively(join poly 1 with 2,3,4,5). The problem now is that I need to modify this script to join the poly 1,3,5.Someone can help me with this please Thank you in advence The Script: Procedure TheProcedure; {debug} VAR x,y,d: REAL; r, g, b :LONGINT; h,h1: HANDLE; s: STRING; i,j,n,vtx,m,ii,i2: INTEGER; p1,p2: POINT; Myp,Myp2: DYNARRAY OF POINT3D; {----------------------------------------------------------------------} Procedure DrawPol(Myp: DYNARRAY of POINt3D;i:INTEGER); VAR h1,h:HANDLE; j:INTEGER; BEGIN layer ('new Lines'); OpenPoly; BeginPoly; For j:=1 To i do BEGIN IF Myp[j].z=0 Then Addpoint(Myp[j].x,Myp[j].y); IF Myp[j].z=1 Then CurveTo(Myp[j].x,Myp[j].y); IF Myp[j].z=2 Then CurveThrough(Myp[j].x,Myp[j].y); END; EndPoly; h1:=LNewObj; ColorIndexToRGB(7, r, g, b); SetPenFore(h1, r, g, b); SetFPat(h1,0); layer(s); END; {----------------------------------------------------------------------} {----------------------------------------------------------------------} Procedure Del_Points(Myp: DYNARRAY of POINt3D;i:INTEGER; Dist: REAL; Dist2: REAL; VAR Myp2: DYNARRAY of POINt3D; VAR jj: INTEGER ); VAR d: REAL; j: INTEGER; BEGIN jj:=1; FOR j:=1 TO i-1 DO BEGIN d:= Sqrt (Sqr((Myp[j+1].x-Myp[j].x))+Sqr((Myp[j+1].y-Myp[j].y))); IF MyP[j].z>0 THEN BEGIN IF d>dist THEN BEGIN MyP2[jj]:=MyP[j]; jj:=jj+1; END; END ELSE BEGIN IF d>dist2 THEN BEGIN MyP2[jj]:=MyP[j]; jj:=jj+1; END; END; END; MyP2[jj]:=MyP; END; {----------------------------------------------------------------------} Procedure FindP(x,y : REAL;h: HANDLE; VAR ii: INTEGER; VAR xp,yp : REAL); VAR x1,x2,y1,y2,dst1,dst2: REAL; i: INTEGER; BEGIN i:=GetVertNum(h); GetPolylineVertex(h,1,x1,y1,vtx,d); dst1:= Sqrt( Sqr(x1-x) + sqr(y1-y) ); GetPolylineVertex(h,i,x2,y2,vtx,d); dst2:= Sqrt( Sqr(x2-x) + sqr(y2-y) ); IF dst1>dst2 THEN BEGIN xp:=x2; yp:=y2; ii:=i; END; IF dst1 xp:=x1; yp:=y1; ii:=1; END; END; {----------------------------------------------------------------------} BEGIN h:=ActLayer; s:=GetLName(h); n:=NumSObj(h); h:=FSActLayer; GetPt(x,y); ii:=1; FindP(x,y,h,ii,x,y); FOR m:=1 TO n DO BEGIN i:=GetVertNum(h); ALLOCATE Myp[1..i+1]; ALLOCATE Myp2[1..i+1]; IF ii=1 THEN BEGIN FOR j:=1 TO i DO BEGIN GetPolylineVertex(h,j,Myp[j].x,Myp[j].y,Myp[j].z,d); END; END; IF ii=i THEN BEGIN FOR j:=1 TO i DO BEGIN GetPolylineVertex(h,i+1-j,Myp[j].x,Myp[j].y,Myp[j].z,d); END; END; h1:=NextSObj(h); IF h1<>NIL THEN BEGIN i:=i+1; FindP(Myp[i-1].x,Myp[i-1].y,h1,ii,Myp.x,Myp.y); Myp.z:=0; END; Del_Points (Myp,i,.2,.2,MyP2,i2); DrawPol(Myp2,i2); h:=NextSObj(h); END; layer ('new Lines'); END; RUN (TheProcedure);