问题描述
我正在尝试使用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中的某些循环中的拉伸不起作用的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!