Article	60000330
Type	Wish
Product	Engine
Version	6009
Date Added	11/26/2007
Fixed	Yes [11/26/2007]
Submitted by	George Siarov
Keywords

Subject

Export the Contours, ContourLevels of GroundSurface object to the professional.tlb

Summary

Export Contours, ContourLevels so they can used under Delphi

Solution

In version 6010 beta 6 and above the Conours property and the ContourLevels are exported to the Professional.tlb . For this implementation we have imported VectorDraw.Geometry.tlb ,VectorDraw.Professional.tlb, VectorDraw.Serialize.tlb and also vdrawi5.tlb


Here is a sample code in Delphi that creates a vdGroundSurface and handles its contours:

procedure TForm1.Button1Click(Sender: TObject);



var vdGPts :  VectorDraw_Geometry_TLB.Igpoints;
    doc : VectorDraw_Professional_TLB.IvdDocument;
    primary, primary2 : VectorDraw_Professional_TLB.IvdPrimary;
    baseobject, baseobject2 : VectorDraw_Professional_TLB.IvdBaseObject;
    vdGPt : VectorDraw_Geometry_TLB.Igpoint;
    GS :    VectorDraw_Professional_TLB.IvdGroundSurface;
    I, J : integer;
    polycurv : VectorDraw_Professional_TLB.IvdPolyCurves;
    polyLine : VectorDraw_Professional_TLB.IvdPolyLine;
    curves :     VectorDraw_Professional_TLB.IvdCurves;
    onecurve :     VectorDraw_Professional_TLB.IvdCurve;
    fig :    VectorDraw_Professional_TLB.IvdFigure;




begin
   vdraw1.DisplayFrames:=63;
   vdraw1.StatusBar:=true;
   vdraw1.StatusBarMenu:=true;
   vdraw1.EnableAutoGripOn:=true;




   doc := vdraw1.ActiveDocument.WrapperObject as VectorDraw_Professional_TLB.IvdDocument;

   vdGPts := VectorDraw_Geometry_TLB.CogPoints.Create();
   for I:=1 to 15 do   // create a ground sourface from 8 points
   begin
     vdGPt := VectorDraw_Geometry_TLB.CogPoint.Create();
     vdGPts.Add(vdGpt);
   end;

   vdGPTs.Item[0].SetValue(2,3,0);
   vdGPTs.Item[1].SetValue(2,5,0);
   vdGPTs.Item[2].SetValue(2,7,0);
   vdGPTs.Item[3].SetValue(4,5,1.5);
   vdGPTs.Item[4].SetValue(4,3,1);
   vdGPTs.Item[5].SetValue(4,7,0.5);
   vdGPTs.Item[6].SetValue(7,3,1);
   vdGPTs.Item[7].SetValue(7,5,5);
   vdGPTs.Item[8].SetValue(7,7,1);
   vdGPTs.Item[9].SetValue(9,3,0.3);
   vdGPTs.Item[10].SetValue(9,5,0.5);
   vdGPTs.Item[11].SetValue(9,7,1);
   vdGPTs.Item[12].SetValue(11,3,0);
   vdGPTs.Item[13].SetValue(11,5,0.2);
   vdGPTs.Item[14].SetValue(11,7,0);





   GS := VectorDraw_Professional_TLB.CovdGroundSurface.Create();
   baseobject := GS as VectorDraw_Professional_TLB.IvdBaseObject;
   baseobject.SetUnRegisterDocument(doc);
   primary:=GS as VectorDraw_Professional_TLB.IvdPrimary;
   primary.setDocumentDefaults();
   GS.Points := vdGPts;
   GS.MeshSize := 0.1;
   GS.DispMode := DisplayMode_Triangle;//DisplayMode_Mesh;
   GS.ContourLevels.Add(0.4);
   GS.ContourLevels.Add(1.6);
   GS.ContourLevels.Add(2.4);
   doc.ActiveLayOut.entities.AddItem(GS as VectorDraw_Professional_TLB.IvdFigure);
   vdraw1.CommandAction.View3D('VISW');
   vdraw1.CommandAction.Zoom('E',0,0);
   Application.MessageBox('Ground Surface created', 'Look',0  );




    polycurv := GS.Contours  as VectorDraw_Professional_TLB.IvdPolyCurves;
    for i:= 0 to polycurv.Count-1 do
    begin
      curves:=polycurv.item[i] as VectorDraw_Professional_TLB.IvdCurves;
      for j:=0 to curves.Count-1 do
      begin

        onecurve := curves.item[j];
        primary := onecurve as VectorDraw_Professional_TLB.IvdPrimary;
        polyline := VectorDraw_Professional_TLB.CovdPolyline.Create();
        (polyline as VectorDraw_Professional_TLB.IvdPrimary).MatchProperties(primary.Clone(doc),doc);
        baseobject2 := polyline as VectorDraw_Professional_TLB.IvdBaseObject;
        baseobject2.SetUnRegisterDocument(doc);
        primary2:=polyline as VectorDraw_Professional_TLB.IvdPrimary;
        primary2.setDocumentDefaults();
        fig:=polyline as VectorDraw_Professional_TLB.IvdFigure;
        fig.PenColor.FromRGB(255,0,0);
        fig.PenWidth :=0.1;
        doc.ActiveLayOut.entities.AddItem(polyline as VectorDraw_Professional_TLB.IvdFigure);
      end ;
    end ;

   vdraw1.CommandAction.View3D('VISW');
   vdraw1.CommandAction.Zoom('E',0,0);
end;

and the same code in VB 6.0 :

Private Sub Command1_Click()
'Get the document interface of VectorDraw FrameWork
   Dim doc As VectorDraw_Professional.vdDocument
   Set doc = vdpro.ActiveDocument.WrapperObject
'Create a new vdGroundSurface object with VDF Interfaces
   Dim GS As VectorDraw_Professional.vdGroundSurface
   Set GS = New VectorDraw_Professional.vdGroundSurface
   Dim i As Long
   Dim j As Long
Dim vdGPts As VectorDraw_Geometry.gPoints
Dim vdGPt As VectorDraw_Geometry.gPoint
   'typecast the GroundSourface as vdbaseObject
   Dim baseobj As VectorDraw_Professional.vdBaseObject
   Set baseobj = GS
   baseobj.SetUnRegisterDocument doc
   'typecast the GroundSourface as vdPrimary
   Dim Primary As VectorDraw_Professional.vdPrimary
   Set Primary = GS
   Primary.setDocumentDefaults
  Set vdGPts = New VectorDraw_Geometry.gPoints
  For i = 1 To 15 ' // create a ground sourface from 15 points
    Set vdGPt = New VectorDraw_Geometry.gPoint
    vdGPts.Add vdGPt
  Next i
  vdGPts.Item(0).SetValue 2, 3, 0
   vdGPts.Item(1).SetValue 2, 5, 0
   vdGPts.Item(2).SetValue 2, 7, 0
   vdGPts.Item(3).SetValue 4, 5, 1.5
   vdGPts.Item(4).SetValue 4, 3, 1
   vdGPts.Item(5).SetValue 4, 7, 0.5
   vdGPts.Item(6).SetValue 7, 3, 1
   vdGPts.Item(7).SetValue 7, 5, 5
   vdGPts.Item(8).SetValue 7, 7, 1
   vdGPts.Item(9).SetValue 9, 3, 0.3
   vdGPts.Item(10).SetValue 9, 5, 0.5
   vdGPts.Item(11).SetValue 9, 7, 1
   vdGPts.Item(12).SetValue 11, 3, 0
   vdGPts.Item(13).SetValue 11, 5, 0.2
   vdGPts.Item(14).SetValue 11, 7, 0
   



    Set GS.Points = vdGPts
    GS.MeshSize = 0.1
    GS.DispMode = DisplayMode_Mesh '//DisplayMode_Triangle;
    GS.ContourLevels.Add 0.4
    GS.ContourLevels.Add 1.3
    GS.ContourLevels.Add 2.1
   Dim fig As VectorDraw_Professional.vdFigure
   Set fig = GS
   'add vdGroundSurface in the collection entities table
   doc.ActiveLayOut.entities.AddItem fig

   Primary.Update
   fig.Invalidate

   Dim polycurves As VectorDraw_Professional.vdPolyCurves
   Set polycurves = GS.Contours

   Dim curves As VectorDraw_Professional.vdCurves
   Dim Primary2 As VectorDraw_Professional.vdPrimary
   Dim polyLine As VectorDraw_Professional.vdPolyline
   Dim BaseObject2 As VectorDraw_Professional.vdBaseObject
   Dim onecurve As VectorDraw_Professional.vdCurve
   For i = 0 To polycurves.Count - 1
      Set curves = polycurves.Item(i)
      For j = 0 To curves.Count - 1
        Set onecurve = curves.Item(j)
        Set Primary = onecurve
        Set polyLine = New VectorDraw_Professional.vdPolyline
        Set Primary2 = polyLine
        Primary2.MatchProperties Primary.Clone(doc), doc
        Set BaseObject2 = polyLine
        BaseObject2.SetUnRegisterDocument doc
        Primary2.setDocumentDefaults
        Set fig = polyLine
        fig.PenColor.FromRGB 255, 0, 0
        fig.PenWidth = 0.1
        doc.ActiveLayOut.entities.AddItem fig
        Next j
    Next i
   vdpro.CommandAction.Zoom "e", 0, 0
   vdpro.CommandAction.View3D "VISW"
End Sub