SolidWorks机械工程师网——最大的SolidWorks学习平台

标题: 对象变量错误！求HELP [打印本页]
作者: HITSZme    时间: 2017-4-19 17:33
标题: 对象变量错误！求HELP
Sub DrawFromFile0()
   
    '--------------根据0进行判断----------11月17日，0又改为岩石---------------
   
    If intFirstFloor = 1 Then '第一次，使用前视基准面
       Dim swApp As Object
       Dim part As Object
       Dim boolstatus As Boolean
       Dim longstatus As Long, longwarnings As Long
      
       Set swApp = Application.SldWorks
       Set part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2010\templates\零件.prtdot", 0, 0, 0)
       swApp.ActivateDoc2 "零件1", False, longstatus
       Set part = swApp.ActiveDoc
       Dim myModelView As Object
       Set myModelView = part.ActiveView
       myModelView.FrameState = swWindowState_e.swWindowMaximized
       part.SketchManager.InsertSketch True
       boolstatus = part.Extension.SelectByID2("前视基准面", "PLANE", -0.06282108156451, 0.04125232142857, 0, False, 0, Nothing, 0)
       part.ClearSelection2 True
      
        intFirstFloor = 2
    Else           '第二层以后，则使用已有表面作为前视基准面
        part.SketchManager.InsertSketch True
        boolstatus = part.Extension.SelectByID2("", "FACE", 7.54739448312165E-02, -0.020930738106548, (intFile - 1) * 2.00000000000023E-02, False, 0, Nothing, 0)
        part.ClearSelection2 True
    End If
          Dim skSegment As Object
        
        'dblEdgeLength = 0.002       '边长，2mm，转换成0.02m.将来从界面获取，或者设定默认值，可修改
        
        
        '检测每行读取的是1还是0，即每个astr（i,j)的数值是0还是1
        
        ProgressBar2.Max = intCountI
        ProgressBar2.Min = 0
        
        For i = 1 To intCountI  '行循环开始
            For J = 1 To intCountJ   '每行的列循环开始
               
                DblX1 = dblEdgeLength * (J - 1)
                dblY1 = -dblEdgeLength * (i - 1)
                dblX2 = dblEdgeLength * J
                dblY2 = -dblEdgeLength * (i - 1)
                dblX3 = dblEdgeLength * J
                dblY3 = -dblEdgeLength * i
                dblX4 = dblEdgeLength * (J - 1)
                dblY4 = -dblEdgeLength * i
               
                If aStr(i, J) = 0 Then  '如果是空隙,为0位点
                    If J = 1 Then   '第一列，并且是1
                        
                       ' MsgBox ("I,J:" & I & J & "  ： " & "第一列，左侧画竖线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4画线
                    ElseIf aStr(i, J - 1) = 1 Then  '或者是左侧为1,左侧是岩石
                       ' MsgBox ("I,J:" & I & J & "  ： " & "左侧为1，左侧画竖线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4点连接画线
                       
                    End If
                    If i = 1 Then '第一行，单独处理，画上面的线
                      '  MsgBox ("I,J:" & I & J & "  ： " & "第一行，上面画横线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
                        ElseIf aStr(i - 1, J) = 1 Then
                      '  MsgBox ("I,J:" & I & J & "  ： " & "上一行为1,上面是岩石，上面画横线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
                    End If
                    If J = intCountJ Then
                     '   MsgBox ("I,J:" & I & J & "  ： " & "行尾，右侧画竖线")
                        Set skSegment = part.SketchManager.CreateLine(dblX2, dblY2, 0#, dblX3, dblY3, 0#)    '2-3点画线
                    End If
                    If i = intCountI Then '到达最后一行
                      '  MsgBox ("I,J:" & I & J & "  ： " & "最后一行，底侧画横线")
                        Set skSegment = part.SketchManager.CreateLine(dblX3, dblY3, 0#, dblX4, dblY4, 0#)   '3-4点画线
                    End If
                    
                     '以上为1位点
                    ElseIf aStr(i, J) = 1 Then '如果1位点，为岩石
                    '以下为0位点
                    If i > 1 Then '不是第一行
                        If aStr(i - 1, J) = 0 Then  '如果上面是0,上面是孔系，则画上横线
                        '    MsgBox ("I,J:" & I & J & "  ： " & "上面是1，则画上横线")
                            Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
                        End If
                    End If
                    If J > 1 Then '不是第一列
                        If aStr(i, J - 1) = 0 Then '左侧是0，则左侧是孔系,左侧画竖线
                       '     MsgBox ("I,J:" & I & J & "  ： " & "左侧是1，则左侧画竖线")
                            Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4点连接画线
                            part.ClearSelection2 True
                        End If
                    End If
                End If
            Next J   '一行的列循环结束
            
            ProgressBar2.Value = i
            
        Next i  '行循环结束
           
        Set myFeature = part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.02, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
        part.SelectionManager.EnableContourSelection = False
'        part.ViewZoomtofit2
         part.ShowNamedView2 "*上下二等角轴测", 8
        'MsgBox ("第" & intFile & "层结束")
      
'------------------------测试第二层-------------------
'        Part.SketchManager.InsertSketch True
'        boolstatus = Part.Extension.SelectByID2("", "FACE", 0.064739448312165, -0.010930738106548, 2.00000000000023E-02, False, 0, Nothing, 0)
'        Part.ClearSelection2 True
'        Set skSegment = Part.SketchManager.CreateLine(-0.05, 0, 0#, 0.15, 0, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(0.15, 0, 0#, 0.15, -0.075, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(0.15, -0.075, 0#, -0.05, -0.075, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(-0.05, -0.075, 0#, -0.05, 0, 0#)
'        Part.ClearSelection2 True
'        Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.03, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
'        Part.SelectionManager.EnableContourSelection = False
               
        '--------缩小为微米的比例-------------------
        '------注意：在缩放时，如果出现孤立的体，则不能通过程序缩放，也没有任何提示。此时需要手工缩放。
        '------注意：拉伸时，出现一个点被三条以上的线共享，则无法拉伸。即只有角点连接的两条曲线，SW中认为错误。
        
'        Dim myFeature2 As Object
'        Set myFeature2 = Part.FeatureManager.InsertScale(0, True, 0.001, 0.001, 0.001)
        
        '------------缩小后再放大，从窗口上看不出来变化-----------------
'        Part.ViewZoomtofit2
        
        'Unload Me '结束，退出程序
        
End Sub
        
              {做的是个岩石的三维图，编程希望运行出来，但不是我自己编的，导师让我帮忙解决运行，但新手一枚，着实不懂。希望大神能否帮忙看看，此处程序和图片奉上，希望能做出三维立体图}

程序暂时出错处

程序暂时出错处

自行画出的平面图

自行画出的平面图

界面

界面
作者: nijino    时间: 2017-4-20 09:43
对象变量或 With
块变量没有设置（错误 91）
   
创建对象变量有两个步骤。
第一，必须先声明对象变量。然后必须用 Set 语句将一个正确的引用赋值给对象变量。
同样地，With...End With 块必须先用With 语句进入点来执行初始化。
此错误有以下的原因和解决方法：
试图使用的对象变量，还没有用一个正确对象的引用来赋值。
解决方法是给对象变量指定或再指定一个引用。
例如，如果在下列的代码中省略Set 语句的话，那么引用 MyObject 将会产生错误：
  1. Dim MyObject As Object    ' 创建对象变量。
  2. Set MyObject = Sheets(1)    ' 创建一个正确的对象引用。
  3. MyCount = MyObject.Count    ' 计数值赋给 MyCount。
复制代码
试图用的对象变量已经被设为 Nothing。 Set MyObject = Nothing    ' 释放此对象。
MyCount = MyObject.Count    ' 引用了已释放的对象。
再指定引用给对象变量。例如，使用新的Set 语句给对象设置新的引用。
此对象是正确的对象，但没有被设置，因为在对象库中，在 “引用” 对话框中没有被选取。
在 “添加引用” 对话框选择对象库。
在With 块内GoTo 语句的去向。不要跳进With 块。确保块使用 With 语句进入点以执行初始化。
当选了 “设置下一条语句” 命令时，在With 块内指定了一行。With 块必须用With 语句执行初始化。
作者: davidzgwang    时间: 2017-4-20 09:43
活到老学到老！
作者: design100    时间: 2017-4-20 16:56
写得乱七八糟,都没有一段是合理的,叫神仙来都没招
我建议你先去学学怎么样写程序，在多看看SolidworksAPI里面的参考!
作者: HITSZme    时间: 2017-4-20 18:41
design100 发表于 2017-4-20 16:56
写得乱七八糟,都没有一段是合理的,叫神仙来都没招
我建议你先去学学怎么样写程序，在多看看Solidwor ...
程序也不是我写的，因为做的毕设，这是老师的东西，之前学长走了，让我给运行出来。
作者: design100    时间: 2017-4-21 09:21
你给的代码不完整，很多变数多没有怎么帮你！
intCountI=？
intCountJ=？
aStr(i, J)=这个不是函数，是什么变数？
我帮你省略一下，可运行的通，其它你自己在看看，只能帮你到这
Sub DrawFromFile0()
   
    '--------------根据0进行判断----------11月17日，0又改为岩石---------------
       Dim part As Object
       Dim swApp As Object
      
       Dim boolstatus As Boolean
       Dim longstatus As Long, longwarnings As Long
      
       Set swApp = Application.SldWorks
       Set part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2010\templates\零件.prtdot", 0, 0, 0)
       swApp.ActivateDoc2 "零件1", False, longstatus
       Set part = swApp.ActiveDoc
      
    If intFirstFloor = 1 Then '第一次，使用前视基准面
       Dim myModelView As Object
       Set myModelView = part.ActiveView
       myModelView.FrameState = swWindowState_e.swWindowMaximized
      
       boolstatus = part.Extension.SelectByID2("前视基", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
        part.SketchManager.InsertSketch True
       part.ClearSelection2 True
      
      
    Else: intFirstFloor = 2          '第二层以后，则使用已有表面作为前视基准面
   
        boolstatus = part.Extension.SelectByID2("", "FACE", 7.54739448312165E-02, -0.020930738106548, (intFile - 1) * 2.00000000000023E-02, False, 0, Nothing, 0)
        part.SketchManager.InsertSketch True
        part.ClearSelection2 True
    End If
         
         Dim skSegment As Object
         dblEdgeLength = 0.002       '边长，2mm，转换成0.02m.将来从界面获取，或者设定默认值，可修改
               
        '检测每行读取的是1还是0，即每个astr（i,j)的数值是0还是1
        
'        ProgressBar2.Max = intCountI
'        ProgressBar2.Min = 0
        
        For i = 1 To 10  '行循环开始intCountI
            For J = 1 To 10   '每行的列循环开始intCountJ
               
                DblX1 = dblEdgeLength * (J - 1)
                dblY1 = -dblEdgeLength * (i - 1)
                dblX2 = dblEdgeLength * J
                dblY2 = -dblEdgeLength * (i - 1)
                dblX3 = dblEdgeLength * J
                dblY3 = -dblEdgeLength * i
                dblX4 = dblEdgeLength * (J - 1)
                dblY4 = -dblEdgeLength * i
               
'                If aStr(i, J) = 0 Then  '如果是空隙,为0位点
                    If J = 1 Then   '第一列，并且是1
                       ' MsgBox ("I,J:" & I & J & "  ： " & "第一列，左侧画竖线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4画线
'                    ElseIf aStr(i, J - 1) = 1 Then  '或者是左侧为1,左侧是岩石
'                       ' MsgBox ("I,J:" & I & J & "  ： " & "左侧为1，左侧画竖线")
'                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4点连接画线
                    End If
                    If i = 1 Then '第一行，单独处理，画上面的线
                      '  MsgBox ("I,J:" & I & J & "  ： " & "第一行，上面画横线")
                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
'                        ElseIf aStr(i - 1, J) = 1 Then
'                      '  MsgBox ("I,J:" & I & J & "  ： " & "上一行为1,上面是岩石，上面画横线")
'                        Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
                    End If
                    If J = intCountJ Then
                     '   MsgBox ("I,J:" & I & J & "  ： " & "行尾，右侧画竖线")
                        Set skSegment = part.SketchManager.CreateLine(dblX2, dblY2, 0#, dblX3, dblY3, 0#)    '2-3点画线
                    End If
                    If i = intCountI Then '到达最后一行
                      '  MsgBox ("I,J:" & I & J & "  ： " & "最后一行，底侧画横线")
                        Set skSegment = part.SketchManager.CreateLine(dblX3, dblY3, 0#, dblX4, dblY4, 0#)   '3-4点画线
                    End If
'
'                     '以上为1位点
'                    ElseIf aStr(i, J) = 1 Then '如果1位点，为岩石
'                    '以下为0位点
                    If i > 1 Then '不是第一行
'                        If aStr(i - 1, J) = 0 Then  '如果上面是0,上面是孔系，则画上横线
'                        '    MsgBox ("I,J:" & I & J & "  ： " & "上面是1，则画上横线")
                            Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX2, dblY2, 0#)   '1-2点画线
'                        End If
                    End If
                    If J > 1 Then '不是第一列
'                        If aStr(i, J - 1) = 0 Then '左侧是0，则左侧是孔系,左侧画竖线
'                       '     MsgBox ("I,J:" & I & J & "  ： " & "左侧是1，则左侧画竖线")
                            Set skSegment = part.SketchManager.CreateLine(DblX1, dblY1, 0#, dblX4, dblY4, 0#)   '1-4点连接画线
'                            part.ClearSelection2 True
'                        End If
                    End If
'                End If
            Next J   '一行的列循环结束
            
'            ProgressBar2.Value = i
            
        Next i  '行循环结束
        
        
        Set myFeature = part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.02, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
        part.SelectionManager.EnableContourSelection = False
'        part.ViewZoomtofit2
         part.ShowNamedView2 "*上下二等角轴测", 8
        'MsgBox ("第" & intFile & "层结束")
        
        '------------------------测试第二层-------------------
'        part.SketchManager.InsertSketch True
'        boolstatus = part.Extension.SelectByID2("", "FACE", 0.064739448312165, -0.010930738106548, 2.00000000000023E-02, False, 0, Nothing, 0)
'        part.ClearSelection2 True
'        Set skSegment = part.SketchManager.CreateLine(-0.05, 0, 0#, 0.15, 0, 0#)
'        Set skSegment = part.SketchManager.CreateLine(0.15, 0, 0#, 0.15, -0.075, 0#)
'        Set skSegment = part.SketchManager.CreateLine(0.15, -0.075, 0#, -0.05, -0.075, 0#)
'        Set skSegment = part.SketchManager.CreateLine(-0.05, -0.075, 0#, -0.05, 0, 0#)
'        part.ClearSelection2 True
'
'        Set myFeature = part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.03, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
'        part.SelectionManager.EnableContourSelection = False
'
        '--------缩小为微米的比例-------------------
        '------注意：在缩放时，如果出现孤立的体，则不能通过程序缩放，也没有任何提示。此时需要手工缩放。
        '------注意：拉伸时，出现一个点被三条以上的线共享，则无法拉伸。即只有角点连接的两条曲线，SW中认为错误。
        
'        Dim myFeature2 As Object
'        Set myFeature2 = Part.FeatureManager.InsertScale(0, True, 0.001, 0.001, 0.001)
        
        '------------缩小后再放大，从窗口上看不出来变化-----------------
'        Part.ViewZoomtofit2
        
        'Unload Me '结束，退出程序
        
End Sub
作者: HITSZme    时间: 2017-4-22 10:42
intCountI=？
intCountJ=？
aStr(i, J)=  这个应该是读取记事本的0-1数据。。谢谢你帮我改的，能运行了，但是还是只能画一个图层，
Dim aStr(200, 200) As String, i As Integer, J As Integer, intCountI As Integer, intCountJ As Integer '存储行数和列数
    Dim aStrHang(200) As String '读取文件时，记录每行数据，用来分解
    Dim DblX1 As Double, dblY1 As Double, dblX2 As Double, dblY2 As Double, dblX3 As Double, dblY3 As Double, dblX4 As Double, dblY4 As Double '记录角点坐标
    Dim sFName As String, iFNumber As Integer, r As Long
    Dim sFilePath As String '记录文件夹路径
    Dim dblEdgeLength As Double '定义每个方格的边长
    Dim strFileName As String
    Dim aryFileName() As String
    Dim intFirstFloor As Integer  '记录是否第一个文件
    Dim intFile As Integer '循环文件
    Dim swApp As Object
    Dim part As Object
    Dim blnHole As Boolean   '判断是否为孔，调用孔还是岩石的绘制程序
   
Private Sub CommandButton1_Click()
   
    '-------------绘制岩石，0位---------------
    intFirstFloor = 1    '记录是否新建图，以建立草图平面
    blnHole = False
   
    ProgressBar1.Min = 0
    ProgressBar1.Max = ListBox1.ListCount
   
    For intFile = 1 To ListBox1.ListCount
        sFName = aryFileName(0) & "\" & aryFileName(intFile)
        Call ReadDataSpace
        ProgressBar1.Value = intFile
    Next intFile
   
   
End Sub
Sub ReadDataSpace()
'    On Error Resume Next
    '--------以下为打开文件，读取单个文件数据------------
'      With CommonDialog1
'
'        .Filter = "*.txt"
'        .FilterIndex = 1
'        AllowMultiSelect = False
'        .ShowOpen
'
'        '记录文件完整路径和名称
'        sFName = .FileName
'       ' MsgBox (sFName)
'
'
'    End With
    '---------打开文件对话框关闭--------------------------
   
    Dim I1 As Integer
    intCountJ = 0
   
    If sFName = "False" Or sFName = "" Then Exit Sub
    If Len(Dir(sFName, vbDirectory)) > 0 Then  '文件存在
        iFNumber = FreeFile '获取可用文件号
   
        Open sFName For Input As #iFNumber  '用Input方式打开文件
            i = 1
            Do
                Line Input #iFNumber, aStrHang(i)  '整行读取,再分隔
                    
'                     MsgBox ("第" & i & "行:" & aStr(i, 1))  '& aStr(I, 2) & aStr(I, 3) & aStr(I, 4) & aStr(I, 5) & aStr(I, 6) & aStr(I, 7) & aStr(I, 8))
                aStrHang(i) = Replace(aStrHang(i), " ", "")  '去掉所有空格
                aStrHang(i) = Replace(aStrHang(i), ",", "")  '去掉所有逗号,
                intCountJ = Len(aStrHang(i))
               
'                MsgBox ("intCountJ" & i & ":" & intCountJ)
                For I1 = 1 To intCountJ  '分解
                    aStr(i, I1) = Mid(aStrHang(i), I1, 1)
                   ' MsgBox ("第" & I1 & "个数据:" & aStr(i, I1))
                Next
                           
               ' GoTo Aa  '调出循环，减少测试时间
                           
                i = i + 1
            Loop Until EOF(iFNumber)
Aa:
        Close #iFNumber '文件读取完毕，关闭文件
        
        intCountI = i - 1 '记录读取的行数
        
'        MsgBox ("列数intCountJ" & ":" & intCountJ)
'        MsgBox ("行数intCountI" & ":" & intCountI)
        
        dblEdgeLength = 0.002       '边长，2mm，转换成0.002m.将来从界面获取，或者设定默认值，可修改
        If blnHole = False Then
            Call DrawFromFile0   '调用绘图程序，根据文件绘制岩石，点位0
        Else
            Call DrawFromFile1   '绘制孔，点位1
        End If
    End If  '文件存在的情况下，数据处理
   
End Sub       {这个是前面的程序 ，大概的意思就是从好几个记事本里面调用数据来画图，有好几记事本，现在的问题是只能用SW画一个记事本的图，画完之后就不再画了。意思解救只读取一个文件。}
       Next i  '行循环结束
        
        
        Set myFeature = part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.02, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
        part.SelectionManager.EnableContourSelection = False
        Set swApp = _
Application.SldWorks
Set part = swApp.ActiveDoc
Set myModelView = part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
part.ViewZoomToSelection
part.ViewZoomTo2 -0.5, 0.2, 10, -0.01, 0.01, -1 '（对视图左右有影响）
'        part.ViewZoomtofit2
         part.ShowNamedView2 "*上下二等角轴测", 8
        'MsgBox ("第" & intFile & "层结束")
        
        '------------------------测试第二层-------------------
'        Part.SketchManager.InsertSketch True
'        boolstatus = Part.Extension.SelectByID2("", "FACE", 0.064739448312165, -0.010930738106548, 2.00000000000023E-02, False, 0, Nothing, 0)
'        Part.ClearSelection2 True
'        Set skSegment = Part.SketchManager.CreateLine(-0.05, 0, 0#, 0.15, 0, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(0.15, 0, 0#, 0.15, -0.075, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(0.15, -0.075, 0#, -0.05, -0.075, 0#)
'        Set skSegment = Part.SketchManager.CreateLine(-0.05, -0.075, 0#, -0.05, 0, 0#)
'        Part.ClearSelection2 True
'
'        Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, dblEdgeLength, 0.03, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
'        Part.SelectionManager.EnableContourSelection = False
               
        '--------缩小为微米的比例-------------------
        '------注意：在缩放时，如果出现孤立的体，则不能通过程序缩放，也没有任何提示。此时需要手工缩放。
        '------注意：拉伸时，出现一个点被三条以上的线共享，则无法拉伸。即只有角点连接的两条曲线，SW中认为错误。
        
'        Dim myFeature2 As Object
'        Set myFeature2 = Part.FeatureManager.InsertScale(0, True, 0.001, 0.001, 0.001)
        
        '------------缩小后再放大，从窗口上看不出来变化-----------------
'        Part.ViewZoomtofit2
        
        'Unload Me '结束，退出程序
        
End Sub   {这是我之前给的程序后面应该加的一个，不知道有什么问题没，这样加上去。。。大概就是要拉伸放大后才能画第二层，但是也不清楚是先拉伸还是先放大，麻烦看看其中有没有什么错误}

`CY[KJIUD}}DFL769R%X~CF.png

W49O[`[TXR)FR@6A$1CT{UK.png
作者: design100    时间: 2017-4-22 11:04
下次要问问题,资料给全一点
每次解决一个在来一个你有完没完呢
作者: design100    时间: 2017-4-22 11:55
        '------------------------测试第二层-------------------
        part.SketchManager.InsertSketch True
        boolstatus = part.Extension.SelectByID2("", "FACE", 0.064739448312165, -0.010930738106548, 2.00000000000023E-02, False, 0, Nothing, 0)
        part.ClearSelection2 True
'        Set skSegment = part.SketchManager.CreateLine(-0.05, 0, 0#, 0.15, 0, 0#)
'        Set skSegment = part.SketchManager.CreateLine(0.15, 0, 0#, 0.15, -0.075, 0#)
'        Set skSegment = part.SketchManager.CreateLine(0.15, -0.075, 0#, -0.05, -0.075, 0#)
'        Set skSegment = part.SketchManager.CreateLine(-0.05, -0.075, 0#, -0.05, 0, 0#)
        
        Dim vSkLines As Variant
        vSkLines = part.SketchManager.CreateCornerRectangle(0.15, 0, 0, -0.05, -0.075, 0)
        part.ClearSelection2 True
        Dim myFeature As Object
        Set myFeature = part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.002, 0.03, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)
        part.SelectionManager.EnableContourSelection = False
               
        '--------缩小为微米的比例-------------------
        '------注意：在缩放时，如果出现孤立的体，则不能通过程序缩放，也没有任何提示。此时需要手工缩放。
        '------注意：拉伸时，出现一个点被三条以上的线共享，则无法拉伸。即只有角点连接的两条曲线，SW中认为错误。
        
        
        Set myFeature = part.FeatureManager.InsertScale(0, True, 0.001, 0.001, 0.001)
        
        '------------缩小后再放大，从窗口上看不出来变化-----------------
        part.ViewZoomtofit2
作者: HITSZme    时间: 2017-4-22 19:52
design100 发表于 2017-4-22 11:04
下次要问问题,资料给全一点
每次解决一个在来一个你有完没完呢
怪我怪我，因为我也不知道这个程序有多少问题，所以只能一个个问一个个解决。。嘿嘿，谢谢大神了
作者: HITSZme    时间: 2017-4-22 21:58
design100 发表于 2017-4-22 11:55
'------------------------测试第二层-------------------
        part.SketchManager.InsertSke ...
大神，我加你扣扣行吗。。。
作者: cnR1ce    时间: 2017-9-12 12:46
标题: ++
Nice Work! Well Done!



欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/) Powered by Discuz! X3.2