solidworks VBA 中循环中的某些拉伸不起作用

问题描述 投票:0回答:3

我正在尝试使用 VBA 在 SolidWorks API 中运行挤压循环。每个挤出的高度由位图中像素的亮度决定。
在大多数情况下,代码按预期工作,但大约四分之一的挤压根本不起作用。草图已制作,但挤压件尚未制作。 我对这背后的原因感到困惑,因为我没有看到不起作用的模式之间有任何模式。我对 FeatureExtrusion2 进行了快速观察,在那些不起作用的情况下,它返回“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
vba bitmap solidworks
3个回答
1
投票

检查亮度值。

如果您尝试使用 3DSketch 而不是 Sketch,上面的代码可能会起作用。 选择标记为 0 的它。


0
投票

如果问题来自FeatureExtrusion2,您可以尝试FeatureExtrusion3(适用于SolidWorks 2014及以上版本)

还有 Part.Extension.SelectByID2(Sketch, "SKETCH", ... 不是必需的,因为您将 FeatureExtrude 应用于最后创建的草图。如果失败,FeatureExtrude 将无法工作。

或者至少确保在发送FeatureExtrude之前通过读取“boolstatus”值来选择草图。


0
投票
在您的示例中,

亮度的值对于有效的挤出来说太大或太小。 对于FeatureExtrusion2(),深度值以米为单位。

我的测试中可能的最小挤压是 0.0000001 米(0.1 微米)。因此,您必须调整亮度计算以获得 SolidWorks 可以挤出的有效值。

© www.soinside.com 2019 - 2024. All rights reserved.