CADSoftTools

Code: Select all

For i = 0 To arGraph.Length - 1 
	Dim img1 As New CADImage()                
	strFileName = Me.MapPath("") + "\Graph\DXF\" + arGraph(i) + ".dxf"
	Dim Pos As New DPoint(dPoint_X, dPoint_Y, CDbl(i))
	Dim Scale As New DPoint(dScale_X, dScale_Y, 1)
	Dim f1 As New FileRecord(strFileName, Pos, Scale, dRotate)
	img1 = CreateCADImage(f1)
	
	Dim intEntyCnt As Integer = img1.Converter.GetCounts(ConvSection.Entities)                    
	For j = 0 To intEntyCnt - 1
	    Dim objEntity As CADEntity = img1.Converter.GetSection(ConvSection.Entities).Entities(j)
	    Dim entDPoint As DPoint
	    If TypeOf (objEntity) Is CADSpline Then
	        Dim entSpline As CADSpline
	        Dim newSpline As New CADSpline
	        entSpline = CType(objEntity, CADSpline)
	        newSpline.Clone(entSpline)
	        For k = 0 To newSpline.Controls.Count - 1
	            entDPoint = CType(newSpline.Controls(k), DPoint)
	            Dim ent2DPoint As New CAD2DPoint
	            ent2DPoint.X = entDPoint.X
	            ent2DPoint.Y = entDPoint.Y
	            ent2DPoint = Transform(Pos, ent2DPoint, dScale_X, dScale_Y, dRotate, 100, 100)
	            entDPoint.X = ent2DPoint.X
	            entDPoint.Y = ent2DPoint.Y
	            newSpline.Controls(k) = entDPoint
	        Next                            
	        Me.Image.Converter.GetSection(ConvSection.Entities).AddEntity(newSpline)
	        Me.Image.Converter.OnCreate(newSpline)
	        Me.Image.Converter.Loads(newSpline)
	    ElseIf TypeOf (objEntity) Is CADCurvePolygon Then
	        Dim entCADCurvePolygon As CADCurvePolygon
	        Dim newCurvePolygon As New CADCurvePolygon
	        entCADCurvePolygon = CType(objEntity, CADCurvePolygon)                            
	
	        For k = 0 To entCADCurvePolygon.Boundaries.Count - 1
	            Dim myArrayList As ArrayList = New ArrayList
	            Dim v2DBList As CAD2DBoundaryList = New CAD2DBoundaryList
	            v2DBList.BoundaryType = 7       'Polyline type
	            newCurvePolygon.BoundaryData.Add(v2DBList)
	            Dim v2DPolyline As CAD2DPolyline = New CAD2DPolyline
	            v2DBList.Add(v2DPolyline)
	            Dim ent2DPoint As CAD2DPoint
	            myArrayList = entCADCurvePolygon.Boundaries(k)
	            For x As Integer = 0 To myArrayList.Count - 1
	                ent2DPoint = CType(myArrayList.Item(x), CAD2DPoint)
	                ent2DPoint = Transform(Pos, ent2DPoint, dScale_X, dScale_Y, dRotate, 100, 100)
	                v2DPolyline.AddVertex(ent2DPoint)
	            Next
	        Next
	        newCurvePolygon.Loaded(Me.Image.Converter)
	        Me.Image.CurrentLayout.Entities.Add(newCurvePolygon)
	        Me.Image.Converter.OnCreate(newCurvePolygon)
	    ElseIf TypeOf (objEntity) Is CADPolyLine Then
	        Dim entPolyline As CADPolyLine
	        Dim newPolyline As New CADPolyLine
	
	        entPolyline = CType(objEntity, CADPolyLine)
	        Dim entVertex As CADVertex
	        Dim newVertex As CADVertex
	        For k = 0 To entPolyline.Entities.Count - 1
	            newVertex = New CADVertex
	            entVertex = CType(entPolyline.Entities(k), CADVertex)
	            Dim ent2DPoint As New CAD2DPoint
	            ent2DPoint.X = entVertex.Point.X
	            ent2DPoint.Y = entVertex.Point.Y
	            ent2DPoint = Transform(Pos, ent2DPoint, dScale_X, dScale_Y, dRotate, 100, 100)
	            newVertex.Point = New DPoint(ent2DPoint.X, ent2DPoint.Y, entVertex.Point.Z)
	            newPolyline.Entities.Add(newVertex)
	        Next
	        newPolyline.Closed = True
	        Me.Image.Converter.GetSection(ConvSection.Entities).AddEntity(newPolyline)
	        Me.Image.Converter.OnCreate(newPolyline)
	        Me.Image.Converter.Loads(newPolyline)
	    End If
	Next	
Next
SaveAsDXF(Me.MapPath("") + "\Graph\Out\" + strOutFName + ".dxf")


Private Sub SaveAsDXF(ByVal fName As String)
    Dim exp1 As CADImport.Export.DirectCADtoDXF.CADtoDXF
    If ((Not Me.Image Is Nothing) AndAlso Not TypeOf Me.Image Is CADRasterImage) Then
        exp1 = New CADImport.Export.DirectCADtoDXF.CADtoDXF(Me.Image)
        exp1.SaveToFile(fName)
    End If
End Sub



Public Function Transform(ByVal Pos As DPoint, ByVal ent2DPoint As CAD2DPoint, ByVal dScale_X As Double, ByVal dScale_Y As Double, ByVal dRotate As Double, ByVal dWidth As Double, ByVal dHeight As Double) As CAD2DPoint

    Dim ret As CAD2DPoint = New CAD2DPoint

    Dim dRadian, dScaleShift_X, dScaleShift_Y, dRotateShift_X, dRotateShift_Y As Double
    Dim dPoint_X, dPoint_X1 As Double
    Dim dPoint_Y, dPoint_Y1 As Double
    Dim bScaleShift As Boolean = False
    Dim bRotateShift As Boolean = False

    dRadian = Math.PI / 180 * dRotate
    If dScale_X <> 1 Or dScale_Y <> 1 Then
        dScaleShift_X = dWidth * (1 - dScale_X)
        dScaleShift_Y = dHeight * (1 - dScale_Y)
        bScaleShift = True
    End If

    If dRotate <> 0 Then
        If (bScaleShift = True) Then
            dRotateShift_X = dWidth - Math.Cos(dRadian) * (dWidth * dScale_X) + Math.Sin(dRadian) * (dHeight * dScale_Y)
            dRotateShift_Y = dHeight - Math.Cos(dRadian) * (dHeight * dScale_Y) - Math.Sin(dRadian) * (dWidth * dScale_X)
        Else
            dRotateShift_X = dWidth - Math.Cos(dRadian) * dWidth + Math.Sin(dRadian) * dHeight
            dRotateShift_Y = dHeight - Math.Cos(dRadian) * dHeight - Math.Sin(dRadian) * dWidth
        End If
        bRotateShift = True
    End If

    dPoint_X = ent2DPoint.X
    dPoint_Y = ent2DPoint.Y
    If dScale_X <> 1 Or dScale_Y <> 1 Then
        dPoint_X = dPoint_X * dScale_X
        dPoint_Y = dPoint_Y * dScale_Y
    End If

    If dRotate <> 0 Then
        dPoint_X1 = dPoint_X
        dPoint_Y1 = dPoint_Y
        dPoint_X = dPoint_X1 * Math.Cos(dRadian) - dPoint_Y1 * Math.Sin(dRadian)
        dPoint_Y = dPoint_X1 * Math.Sin(dRadian) + dPoint_Y1 * Math.Cos(dRadian)
    End If
    If bRotateShift = True Then
        dPoint_X = dPoint_X + dRotateShift_X
        dPoint_Y = dPoint_Y + dRotateShift_Y
    ElseIf bScaleShift = True Then
        dPoint_X = dPoint_X + dScaleShift_X
        dPoint_Y = dPoint_Y + dScaleShift_Y
    End If
    dPoint_X = dPoint_X + Pos.X - dWidth
    dPoint_Y = dPoint_Y + Pos.Y - dHeight
    ret.X = dPoint_X
    ret.Y = dPoint_Y
    Return ret
End Function