Some extrusions in loop in solidworks VBA don't work

问题

I am attempting to run a loop of extrusions in solidworks API using VBA. The height of each extrusion is determined by the brightness of the pixels in a bitmap.
For the most part the code works as expected however about a quarter of the extrusions simply don't work. The Sketches are made but the extrusions aren't. I am at a loss as to the reason behind this as I don't see any pattern between the ones that don't work. I ran a quickwatch on the FeatureExtrusion2 and in the ones that didn't work it returned "Nothing" and the ones that did, did not have a return value.

Any help at all will be hugely appreciated

This here is the entire code:

Option Explicit

Private Type typHeader
    Tipo As String * 2
    Tamanho As Long
    res1 As Integer
    res2 As Integer
    Offset As Long
End Type

Private Type typInfoHeader
    Tamanho As Long
    Largura As Long
    Altura As Long
    Planes As Integer
    Bits As Integer
    Compression As Long
    ImageSize As Long
    xResolution As Long
    yResolution As Long
    nColors As Long
    ImportantColors As Long
End Type

Private Type typePixel
    b As Byte
    g As Byte
    r As Byte
End Type

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Sketch As String

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

    Dim bmpHeader As typHeader
    Dim bmpInfoHeader As typInfoHeader
    Dim bmpPixel As typePixel

    Dim nCnt As Long
    Dim nRow As Integer, nCol As Integer
    Dim nRowBytes As Long
    Dim Count As Integer
    Dim Brightness As Double
    Count = 0

    Dim fBMP As String

    'read and open the bmp file
    fBMP = "E:\bmp2xls\Sample.BMP"

    Open fBMP For Binary Access Read As 1 Len = 1

        Get 1, 1, bmpHeader
        Get 1, , bmpInfoHeader
        nRowBytes = bmpInfoHeader.Largura * 3
        If nRowBytes Mod 4 <> 0 Then
            nRowBytes = nRowBytes + (4 - nRowBytes Mod 4)
        End If
        'Start actual conversion, reading each pixel...
        For nRow = 0 To bmpInfoHeader.Altura - 1
            For nCol = 0 To bmpInfoHeader.Largura - 1
                Get 1, bmpHeader.Offset + 1 + nRow * nRowBytes + nCol * 3, bmpPixel

                If bmpPixel.r <> 0 Or bmpPixel.g <> 0 Or bmpPixel.b <> 0 Then 'ignore black pixels
                    Part.ClearSelection2 True
                    Count = Count + 1
                    Sketch = "Sketch" & Count
                    boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", -7.12137837928797E-02, -5.58089325155595E-04, 3.79577007740569E-02, False, 0, Nothing, 0) 'select front plane
                    Part.SketchManager.InsertSketch True 'insert sketch
                    Dim vSkLines As Variant
                    vSkLines = Part.SketchManager.CreateCornerRectangle(0.005 * nCol, -0.005 * (bmpInfoHeader.Altura - nRow), 0, 0.005 * nCol + 0.005, -0.005 * (bmpInfoHeader.Altura - nRow) + 0.005, 0) 'sketch square
                    Part.SketchManager.InsertSketch True 'exit sketch
                    Part.ShowNamedView2 "*Trimetric", 8
                    boolstatus = Part.Extension.SelectByID2(Sketch, "SKETCH", 0, 0, 0, False, 4, Nothing, 0) 'select sketch
                    Dim myFeature As Object
                    Brightness = 0.05 - (0.299 * bmpPixel.r + 0.587 * bmpPixel.g + 0.114 * bmpPixel.b) / (255) * (0.05)
                    'extrude to height=Brightness
                    Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, Brightness, 0, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
                    Part.SelectionManager.EnableContourSelection = False

                End If

            Next
        Next

    Close

End Sub

回答1:

Check the value of brightness.

Perhaps if you tried to use 3DSketch instead of Sketch, this code above will work. Select it with a mark of 0.

回答2:

If the problem comes from FeatureExtrusion2, you could try FeatureExtrusion3 for SolidWorks 2014 and above

Also Part.Extension.SelectByID2(Sketch, "SKETCH", ... is not necessary since you applied the FeatureExtrude to the last created sketch .And if it fails FeatureExtrude won't work.

Or at least make sure the sketch is selected before sending FeatureExtrude by reading the 'boolstatus' value.

回答3:

The value of Brightness in your example is to big or to small for a valid extrusion. For FeatureExtrusion2() the value for the depth is in meters.

The smallest extrusion possible in my test was 0.0000001 meters (0.1 micrometer). So you have to adjust your brightness calculation to get valid values which solidworks is possible to extrude.

来源：https://stackoverflow.com/questions/39567191/some-extrusions-in-loop-in-solidworks-vba-dont-work

标签

vba

bitmap

macros

solidworks