60000330 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;

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

Send comments on this topic.