procedure combine;
LABEL
    1;
CONST
    ARRAYSIZE=2;
    SLOPFACTOR=.001;
                        {For English version - Thanks to Lamberto
Previati}
    {}
    MMCut='Cut';
    MMCopy='Copy';
    MMPasteInPlace='Paste in Place';
    MMConvToPoly='Convert To Polygons';
    {}

    {For Italian or other version, comment out (with braces) the lines
above.
        Then place the proper menu titles below, and remove the braces}
    {
    MMCut='Taglia';
    MMCopy='Copia';
    MMPasteInPlace='Incolla Riportando';
    MMConvToPoly='Converti in Poligoni';
    }

VAR
    n,m:INTEGER;
    s,t:STRING;
    h,nh,sh:HANDLE;
    x1a,y1a,x2a,y2a:ARRAY [1..ARRAYSIZE] OF REAL;
    ha:ARRAY [1..ARRAYSIZE] OF HANDLE;
    totalvert:INTEGER;
    totalobj:INTEGER;
    vertcount:INTEGER;
    x1,y1,x2,y2,x3,y3,x4,y4:REAL;
    xcurrent,ycurrent:REAL;
    whichend:INTEGER;
    xc,yc:REAL;
    shortlength,shorttest:REAL;
    objcurrent:INTEGER;
    whichstart:INTEGER;
    pressed,deletem:BOOLEAN;
    asciicode:INTEGER;
    
procedure storem(n:INTEGER);    {store endpoints into arrays}
BEGIN
        x1a[n]:=x1;
        x2a[n]:=x2;
        y1a[n]:=y1;
        y2a[n]:=y2;
END;

procedure getem(n:INTEGER);    {retrieve endpoints from arrays}
BEGIN
        x1:=x1a[n];
        x2:=x2a[n];
        y1:=y1a[n];
        y2:=y2a[n];
END;

procedure findclosest(objc,whiche:INTEGER); {find closest endpoint}
VAR
    shortest:INTEGER;
    n:INTEGER;
BEGIN
    if whiche=1 then begin
        xc:=x1a[objc];
        yc:=y1a[objc];
    end else begin
        xc:=x2a[objc];
        yc:=y2a[objc];
    end;

    shortlength:=100000;
    
    for n:=1 to totalobj do begin
        if ((n<>objc)&(ha[n]<>NIL))then begin
        
            getem(n);
            
            if (sqrt((xc-x1)^2+(yc-y1)^2)<shortlength) then begin
                shortlength:=sqrt((xc-x1)^2+(yc-y1)^2);
                shortest:=n;
                whichend:=1;
                h:=ha[n];
            end;
            if (sqrt((xc-x2)^2+(yc-y2)^2)<shortlength) then begin
                shortlength:=sqrt((xc-x2)^2+(yc-y2)^2);
                shortest:=n;
                whichend:=2;
                h:=ha[n];
            end;
        end;
    end;
    objcurrent:=shortest;
    ha[shortest]:=NIL;
    getem(shortest);
END;


procedure findclose(objc,whiche:INTEGER); {find closest endpoint, dont
erase}
VAR
    shortest:INTEGER;
    n:INTEGER;
BEGIN
    if whiche=1 then begin
        xc:=x1a[objc];
        yc:=y1a[objc];
    end else begin
        xc:=x2a[objc];
        yc:=y2a[objc];
    end;

    shortlength:=100000;
    
    for n:=1 to totalobj do begin
        if ((n<>objc)&(ha[n]<>NIL))then begin
        
            getem(n);
            
            if (sqrt((xc-x1)^2+(yc-y1)^2)<shortlength) then begin
                shortlength:=sqrt((xc-x1)^2+(yc-y1)^2);
                shortest:=n;
                whichend:=1;
                h:=ha[n];
            end;
            if (sqrt((xc-x2)^2+(yc-y2)^2)<shortlength) then begin
                shortlength:=sqrt((xc-x2)^2+(yc-y2)^2);
                shortest:=n;
                whichend:=2;
                h:=ha[n];
            end;
        end;
    end;
END;





BEGIN       {=========================== Main Program ==============}
    totalobj:=count(((SEL=TRUE)));
    if (totalobj<2) then begin
        AlrtDialog('Please select 2 or more objects to combine.'); 
        goto 1;
    end;
    if totalobj>arraysize-1 then begin
        AlrtDialog('Too many objects. Increase constant ARRAYSIZE. Press
Option (Alt on PC) & doubleclick on command to edit.');
        Goto 1;
    end;
    message('Press space bar when clicking to delete objects.');
    wait(1);
    deletem:=false;
    asciicode:=0;
    pressed:=AutoKey(asciiCode);
    if asciicode=32 then deletem:=true;
    if deletem then domenutext(MMCut) else domenutext(MMCopy);
    domenutext(MMPasteInPlace);
                                        {remove fills}
    h:=fsactlayer;
    while h<>NIL do begin
        if gettype(h)<>2 then setfpat(h,0);
        h:=nextsobj(h);
    end;
    
    
    
    
    domenutext(MMConvToPoly);
    

    h:=fsactlayer;
    totalobj:=count(((SEL=TRUE)));
 
    {place start and end points in an array}
 
 for n:=1 to totalobj do begin
    ha[n]:=h;
    if gettype(h)=2 then begin
        GetSegPt1(h,x1,y1);
        GetSegPt2(h,x2,y2);
        storem(n);
    end;
    if gettype(h)=5 then begin
        vertcount:=GetVertNum(h);
        GetPolyPt(h,1,x1,y1);
        GetPolyPt(h,vertcount,x2,y2);
        storem(n);
    end;

    h:=nextsobj(h);
 end;
 
                    {draw first part of polygon for surface}
    getem(1);
    h:=ha[1];
    
    findclose(1,1);
    shorttest:=shortlength;
    findclose(1,2);
    if (shortlength>shorttest) then begin
        whichstart:=2;
    end else begin
        whichstart:=1;
    end;
        
    getem(1);
    h:=ha[1];
    closepoly;
    beginpoly;

    if gettype(h)=2 then begin
        if whichstart=1 then begin
            moveto(x1,y1);
            lineto(x2,y2);
        end else begin
            moveto(x2,y2);
            lineto(x1,y1);
        end;
    end;
    if gettype(h)=5 then begin
        if whichstart=1 then begin
            moveto(x1,y1);
            vertcount:=GetVertNum(h);
            for m:=2 to vertcount do begin
                GetPolyPt(h,m,x2,y2);
                lineto(x2,y2);
            end;
        end else begin
            moveto(x2,y2);
            vertcount:=GetVertNum(h);
            for m:=vertcount-1 downto 1 do begin
                GetPolyPt(h,m,x2,y2);
                lineto(x2,y2);
            end;
        end;
            
    end;

    
    
    ha[1]:=NIL;

    objcurrent:=1;
    if whichstart=1 then begin
        whichend:=2;
    end else begin
        whichend:=1;
    end;
    delobject(h);
    for n:=2 to totalobj do begin
        findclosest(objcurrent,whichend);
    {draw next objects=====================================}
    
        if gettype(h)=2 then begin
            if shortlength<SLOPFACTOR then begin
                if whichend=2 then begin
                    lineto(x1,y1);
                end else begin
                    lineto(x2,y2);
                end;
            end else begin
               if whichend=2 then begin
                   lineto(x2,y2);
                   lineto(x1,y1);
               end else begin
                   lineto(x1,y1);
                   lineto(x2,y2);
               end;
           end;
        end;
        
        
        if gettype(h)=5 then begin
           vertcount:=GetVertNum(h);
           if shortlength<SLOPFACTOR then begin
               if whichend=1 then begin
                   for m:=2 to vertcount do begin
                       GetPolyPt(h,m,x2,y2);
                       lineto(x2,y2);
                   end;
               end else begin
                   for m:=vertcount-1 downto 1 do begin
                       GetPolyPt(h,m,x2,y2);
                       lineto(x2,y2);
                   end;
               end;
           end else begin
               if whichend=1 then begin
                   for m:=1 to vertcount do begin
                       GetPolyPt(h,m,x2,y2);
                       lineto(x2,y2);
                   end;
               end else begin
                   for m:=vertcount downto 1 do begin
                       GetPolyPt(h,m,x2,y2);
                       lineto(x2,y2);
                   end;
               end;
           end;
       end;
       if (whichend=1) then begin
           whichend:=2 
       end else begin 
           whichend:=1;
       end;
       delobject(h);   

    end;
    
    endpoly;
    
    h:=LNewObj;
    vertcount:=GetVertNum(h);
    getem(objcurrent);
    x3:=x1;
    y3:=y1;
    x4:=x2;
    y4:=y2;
    getem(1);
    
    {remove duplicate vertex if it exists}
    if ((((x1=x3)&(y1=y3))|((x1=x4)&(y1=y4)))& (whichstart=1)) then
DelVertex(h,vertcount);
    if ((((x2=x3)&(y2=y3))|((x2=x4)&(y2=y4)))& (whichstart=2)) then
DelVertex(h,vertcount);

    redrawall;
    clrmessage;

1:END;
run(combine);