vba - Solidworks VBA 中的某些循环挤压不起作用

Question

我正在尝试使用 VBA 在 Solidworks API 中运行一个挤压循环。每个挤压的高度由位图中像素的亮度决定。
在大多数情况下，代码按预期工作，但是大约四分之一的挤压根本不起作用。草图是制作的，但挤压不是。
我不知道这背后的原因，因为我没有看到不起作用的那些之间的任何模式。我在 FeatureExtrusion2 上运行了一个 quickwatch，在那些不起作用的情况下它返回了“Nothing”，而那些起作用的却没有返回值。

任何帮助都将不胜感激

这是完整的代码:

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

Answer 1

检查亮度值。

也许如果您尝试使用 3DSketch 而不是 Sketch，上面的代码将起作用。
选择它，标记为 0。