option base 1

type line2d
    p1 as MbePoint
    p2 as MbePoint
end type 


Sub main()

Dim elemSet as New MbeElementSet
Dim element as New MbeElement
Dim elem as MbeSetMember

dim txt as new MbeElement
dim shape as new MbeElement

Dim shapes() as long 
Dim texte() as  long

dim p1() as Mbepoint


dim p0 as MbePoint
dim point as MbePoint

dim text$ as string
Dim filePos as Long
dim iedf as integer
dim edf() as MbeEDfield

dim k as integer
dim x1 as double
dim x2 as double
dim y1 as double
dim y2 as double
dim gefunden as integer
dim inshape as integer



' Zaunsettings auf Element im Zaun + overlap  gesetzt

MbeSettings.fenceclip   =0
MbeSettings.fenceoverlap=1
MbeSettings.fencevoid   =0


'----------------- pruefen ob ein Zaun gesetzt wurde

if elemset.fromfence(0) = MBE_Success then
   rem  print "Ein Zaun gesetzt !"
else
    print  "Kein Zaun für Auswahlsatz gesetzt!"
   return
end if

'----------------- Inhalt des Zaunes einlesen 

i=0
j=0
status = elemset.getFirst(elem)

do while status = MBE_Success
        filepos =element.fromfile(elem.filepos,elem.filenum)
                if element.type=MBE_text  then
                        i=i+1
                        redim preserve texte(1 to i)
                        texte(i)=element.filepos
                end if
                if element.type=MBE_shape  then
                        j=j+1
                        redim preserve shapes(1 to j)
                        shapes(j)=element.filepos
                end if
    status=elemset.getnext(elem)
loop
elemset.clear

'----------------- text-elemente mit shapes vergleichen 


  for i=lbound(texte) to ubound(texte)
       filepos =txt.fromfile(texte(i),0)
           status=txt.getstring(text$,iedf,edf)
           status=txt.getorigin(point)
  k=-1         
  for j=lbound(shapes) to ubound(shapes)
       filepos =shape.fromfile(shapes(j),0)
                    if inshape(point,shape) then
                      status=shape.getpoints(p1)
                      status=setgg (point,p1(1))
                      k=j
                    end if
    next j
    
    if k>0 then
         print i,"text [";text$;"] in shape ";k;"gefunden"
    else
         print i,"text [";text$;"] in keinem shape gefunden"
    end if
    
 next i

 end sub

'----------------- function um elemente einer GG zuzuordnen 

function  setgg(point1 as MbePoint ,point2 as MbePoint) as integer
    settg=0
    
    MbeSendCommand "GROUP ADD "
    MbeSendDataPoint point1, 1%
    MbeSendDataPoint point2, 1%
    MbeSendDataPoint point2, 1%
    
end function


'----------------- function um linie zu zeichnen 


Sub setline(x1 as double,y1 as double,x2 as double,y2 as double)
  
    Dim point As MbePoint

 
    MbeSendCommand "PLACE SMARTLINE "

    point.x = x1
    point.y = y1
    point.z = 0#
    MbeSendDataPoint point, 1%

    point.x = x2
    point.y = y2
    point.z = 0#
    MbeSendDataPoint point, 1%

    MbeSendReset
End Sub




'----------------- function zur bestimmung eines punktes im shape

function inshape(point as MbePoint,shape as   MbeElement) as integer

dim p1() as MbePoint
dim tab02() as double

dim gefunden as integer
dim i as integer
dim j as integer

dim xmin as double
dim xmax as double
dim ymin as double
dim ymax as double

dim x1 as double
dim x2 as double 
dim x3 as double
dim x4 as double

dim y1 as double
dim y2 as double 
dim y3 as double
dim y4 as double

dim xs  as double
dim ys as  double
dim deltax as double
dim deltay as double


    inshape=0
    deltay=1e-8
    deltax=1e-4
  
 '   
 'shape punkte einlesen
 '
    status=shape.getpoints(p1)
    

    if status = MBE_success then
        else
        return
    end if
 
 
 '   
 'min/max des shapes bestimmen
 '
    
    
    xmin = p1(lbound(p1)).x
    ymin = p1(lbound(p1)).y
    xmax=xmin
    ymax=ymin
    
    print lbound(p1),ubound(p1)
    
    
     for i= lbound(p1) to ubound(p1)
       xmin =min(xmin,p1(i).x)
       xmax =max(xmax,p1(i).x)
       ymin =min(ymin,p1(i).y)
       ymax =max(ymax,p1(i).y)
     next i
 
 
 '   
 'xmin/max verlaengern damit schnittlinie uebersteht
 '
    
     x1=xmin    -deltax
     y1=point.y+deltay
     x2=xmax    +deltax
     y2=point.y+deltay
     
     
 
 '   
 'xmin/max werte in schnittpunktmatrix eintragen
 '
    
     
     
     redim preserve tab02(1 to 2,1 to 1)
     tab02(1,1)=x1
     tab02(2,1)=y1
     
     redim preserve tab02(1 to 2,1 to ubound(tab02,2)+1)
     tab02(1,2)=x2
     tab02(2,2)=y2
     
     
 
 '   
 'alle schnittpunkte der shapelinien mit schnittlinie (min/max) bestimmen
 '
    
    
    for i= lbound(p1) to ubound(p1)-1
     spunkt x1,y1,x2,y2,p1(i).x,p1(i).y,p1(i+1).x,p1(i+1).y,xs,ys,gefunden
     if gefunden then
         redim preserve tab02(1 to 2,1 to ubound(tab02,2)+1)
         tab02(1,ubound(tab02,2))=xs
         tab02(2,ubound(tab02,2))=ys
     end if 
     next i
     
 '   
 'schnittpunkte der groesse nach sortieren xmin<=x<=xmax
 '
    
     
        asort tab02

 '   
 ' linien innerhalb des shapes abzaehlen
 ' linie mit index j=gerade und j+1 ungerade liegt im shape !!!!
 '


j=2
for i=lbound(tab02,2) to ubound(tab02,2)-1
       if j <= ubound(tab02,2)-1 then
            x1=tab02(1,j)
            y1=tab02(2,j)
            x2=tab02(1,j+1)
            y2=tab02(2,j+1)
    '       setline x1,y1,x2,y2
           if x1<=point.x and x2 >= point.x then
 '
 ' liegt der x-wert des untersuchten punktes innerhalb der linie
 ' so liegt der untersuchte punkt auch im shape !!!!!!!
 '
            inshape=-1
           end if
        j=j+2   
    end if
    
next i
          
end function 



'----------------------------------------------------------------------------------

'--------------- function zum sortieren der matrix (nach der 1. spalte)

sub asort(tabx() as double)

dim i as integer
dim j as integer
 
dim xt as double
dim yt as double


for i=lbound(tabx,2) to ubound(tabx,2)-1
    for j=i+1 to ubound(tabx,2)
        if tabx(1,j)< tabx(1,i) then
                xt=tabx(1,i)
                yt=tabx(2,i)
                tabx(1,i)=tabx(1,j)
                tabx(2,i)=tabx(2,j)
                tabx(1,j)=xt
                tabx(2,j)=yt
        end if 
    next j
next i



end sub





'----------------------------------------------------------------------------------
function min (a#,b#) as double


min=b

if a < b then
    min=a
end if



end function

'----------------------------------------------------------------------------------
function max (a#,b#) as double
max=b

if a > b then
    max=a
end if

end function


'----------------------------------------------------------------------------------

'
'---------- routine zur bestimmung des schnittpunktes von 2 linien
'
sub spunkt(x1#,y1#,x2#,y2#,x3#,y3#,x4#,y4#,xs#,ys#,sp%)

dim l1 as double
dim l2 as double
dim n1 as double
dim n2 as double 
dim d1 as double
dim d2 as double
dim d as double
dim l as double
dim n as double
dim schnittpunkt as integer

 schnittpunkt=0
 
 
    l1=x2-x1
    l2=y2-y1
    
    n1=-(x4-x3)
    n2=-(y4-y3)
    
    d1=x3-x1
    d2=y3-y1
    
    d=l1*n2-l2*n1
    
    
    
    if d <> 0 then  
        n=(l1*d2-l2*d1)/d
        l=(d1*n2-d2*n1)/d
        xs=x1+l*l1
        ys=y1+l*l2
        
    if l>=0 and l<=1 and n>=0 and n<=1 then
            schnittpunkt=-1
       end if
       
    else
'        print "Determinate = NULL: ",d 
    end if    
    
    sp=schnittpunkt
    
end sub