SolidWorks VBA中的某些循环中的拉伸不起作用 [英] Some extrusions in loop in solidworks VBA don't work

问题描述

我正在尝试使用VBA在solidworks API中运行拉伸循环.每次拉伸的高度取决于位图中像素的亮度.
在大多数情况下，代码可以按预期工作，但是大约四分之一的挤出根本无法工作.草绘已完成，但拉伸未完成. 我对此背后的原因感到茫然，因为我看不到那些无效的模式之间的任何模式.我在FeatureExtrusion2上运行了一个快速监视，在不起作用的监视中返回了"Nothing"，而在不起作用的监视中没有返回值.

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.

任何帮助将不胜感激

这是完整的代码:

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

推荐答案

检查亮度值.

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

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

这篇关于SolidWorks VBA中的某些循环中的拉伸不起作用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！