QQ登录

只需一步,快速开始

登录 立即注册

求高手指点:SOLIDWORKS二次开发,草图尺寸过小画不出来

[复制链接]
查看: 2434|回复: 9
3dl99 发表于 2017-2-27 12:49:57
本帖最后由 3dl99 于 2017-2-27 12:49 编辑

代码如下:
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.NewDocument("C:\ProgramData\SOLIDWORKS\SOLIDWORKS 2016\templates\gb_part.prtdot", 0, 0, 0)
swApp.ActivateDoc2 "零件10", False, longstatus
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
boolstatus = Part.Extension.SelectByID2("右视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(-0#, 0#, 0#, -0.04, 0#, 0#)
Dim myDisplayDim As Object
Set myDisplayDim = Part.AddDimension2(0, 0, 0.08)
Dim myDimension As Object
Set myDimension = Part.Parameter("D1@草图1")
myDimension.SystemValue = 0.08
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 4, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.025, 0.01, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
boolstatus = Part.Extension.SelectByID2("前视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
Set skSegment = Part.SketchManager.CreateLine(0.025, 0.04, 0#, 0.025, 0.0395, 0#)
Set myDisplayDim = Part.AddDimension2(0.0125, 0, 0)
Set myDimension = Part.Parameter("D1@草图2")
myDimension.SystemValue = 0.025
Set skSegment = Part.SketchManager.CreateTangentArc(0.025, 0.0395, 0#, 0.024, 0.0385, 0#, 1)
Set myDisplayDim = Part.AddDimension2(2.89399382876436E-02, 2.61073389938628E-02, 0)
Set myDimension = Part.Parameter("D2@草图2")
myDimension.SystemValue = 0.001
Set skSegment = Part.SketchManager.CreateLine(0.024, 0.0385, 0#, 0.02191, 0.0385, 0#)
boolstatus = Part.Extension.SelectByID2("Point1@原点", "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
Set myDisplayDim = Part.AddDimension2(3.42404606501259E-02, 1.42539931178805E-02, 0)
Set myDimension = Part.Parameter("D3@草图2")
myDimension.SystemValue = 0.0385
Set skSegment = Part.SketchManager.CreateTangentArc(0.02191, 0.0385, 0#, 0.02121, 0.03879, 0#, 1)
Set myDisplayDim = Part.AddDimension2(1.19039736417416E-02, 2.72702034748118E-02, 0)
Set myDimension = Part.Parameter("D4@草图2")
myDimension.SystemValue = 0.001
Set skSegment = Part.SketchManager.CreateLine(0.02121, 0.03879, 0#, 0.02, 0.04, 0#)
boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 1.76020095983914E-02, 3.00610782290892E-02, 0, True, 0, Nothing, 0)
Set myDisplayDim = Part.AddDimension2(1.04503930405554E-02, 3.22705207428922E-02, 0)
Set myDimension = Part.Parameter("D5@草图2")
myDimension.SystemValue = 0.7853981633975
Set skSegment = Part.SketchManager.CreateLine(0.02, 0.04, 0#, 0.025, 0.04, 0#)
Set myDisplayDim = Part.AddDimension2(2.01415785075547E-02, 4.37906377501396E-02, 0)
Set myDimension = Part.Parameter("D6@草图2")
myDimension.SystemValue = 0.005
Part.ClearSelection2 True
End Sub下面是橙色部分的草图

黑色部分已经编译通过,橙色部分因为草图过小,运行宏程序时会漏掉不少线段
有哪位高手能帮忙解决一下?


楼主  3dl99 发表于 2017-2-27 12:49:58
补上橙色部分的草图。。。
无标题_看图王.png
TerryZhang 发表于 2017-3-7 16:24:50
我试一下,最近这段时间,电脑上没装SW;
楼主  3dl99 发表于 2017-3-7 18:49:30
本帖最后由 3dl99 于 2017-3-7 18:51 编辑
TerryZhang 发表于 2017-3-7 16:24
我试一下,最近这段时间,电脑上没装SW;

好的,谢谢!
春天花会开 发表于 2017-4-17 11:35:20
在画线之前调用AddToDB函数,并且设置为true,这样就避免因为线段靠的近而自动选择已经有的端点。
画完后还原AddToDB为false。

参见:AddToDB的APIhelp。
何岩 发表于 2017-5-18 00:34:29
楼主会vb.net对SOLIDWORKS二次开发么?
MrWorm 发表于 2018-7-25 16:17:20
5楼正解,也可以直接设置SOLIDWORKS,关闭自动捕捉
——来自刘典军的回复
tangxs 发表于 2018-7-27 15:53:43
可以用swApp.SetUserPreferenceToggle swSketchInference, True       '开启对象捕捉(必须命令)和swApp.SetUserPreferenceToggle swSketchInference, False       '关闭对象捕捉(必须命令),若遇到有点无法重合的话,可以先固定一个点,让另一个点让开几mm,再用添加关系合并点即可:swApp.SetUserPreferenceToggle swSketchInference, False       '关闭对象捕捉(必须命令)

'建立刀片台消气草图
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID2("基准面3", "PLANE", 0, (PYL - S) / 1000, 0, False, 0, Nothing, 0)
Part.InsertSketch2 True


Part.CreateLine2 DPX1 / 1000, -(DPY1 - T * Tan(CC1 * pi / 180)) / 1000, 0, (DPX2 + 5) / 1000, -(DPY2 - T * Tan(CC1 * pi / 180)) / 1000, 0
Part.CreateLine2 (DPX2 - T * Tan(CC1 * pi / 180)) / 1000, -(DPY2 - T * Tan(CC1 * pi / 180)) / 1000, 0, (DPX3 - T * Tan(CC1 * pi / 180)) / 1000, -DPY3 / 1000, 0

'3点固定
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID2("Point3", "SKETCHPOINT", DPX2 / 1000, -DPY2 / 1000, 0, False, 0, Nothing, 0)
Part.SketchAddConstraints "sgFIXED"


swApp.SetUserPreferenceToggle swSketchInference, True       '开启对象捕捉(必须命令)
Part.CreateLine2 DPX3 / 1000, -DPY3 / 1000, 0, DPX4 / 1000, -DPY4 / 1000, 0
Part.CreateLine2 DPX4 / 1000, -DPY4 / 1000, 0, DPX1 / 1000, -DPY1 / 1000, 0

'2.3点添加关系重合
Part.ClearSelection2 True
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID2("Point2", "SKETCHPOINT", (DPX2 + 5) / 1000, -(DPY2 - T * Tan(CC1 * pi / 180)) / 1000, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Point3", "SKETCHPOINT", (DPX2 - T * Tan(CC1 * pi / 180)) / 1000, -(DPY2 - T * Tan(CC1 * pi / 180)) / 1000, 0, True, 0, Nothing, 0)
Part.SketchAddConstraints "sgMERGEPOINTS"
super 发表于 2018-7-30 07:25:44

回复

使用道具 举报

tlp327 发表于 2018-8-1 14:46:21
厉害 厉害  我还在初级阶段学习呢
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|手机版|小黑屋|京ICP备11009482号-2  

400 - 818 - 3535 (中国地区咨询电话) | 达索析统(上海)信息技术有限公司北京分公司

京ICP备11009482号-2 | 电话:01065362288

北京市朝阳区建国路79号华贸中心2号写字楼707-709室,邮编:100025

GMT+8, 2020-10-22 03:45 , Processed in 0.178170 second(s), 40 queries .

Copyright © 2002-2018 Dassault Systèmes - All rights reserved

快速回复 返回顶部 返回列表