根据剖面图及路径自动建立模型
来源:互联网 发布:罪恶之城 知乎 编辑:程序博客网 时间:2024/06/10 16:56
发布一个根据剖面图及路径自动建立模型程序!
原理比较简单,但是很实用!只需要选取模型的断面图和路径,就可自动生成三维实体模型!省去了在空间旋转、移动、生成面域、拉升等操作!如果手动要花2天的时间建模,用这个程序最大2个小时就可以搞定!欢迎试用!
程序界面:
编译程序下载地址:
http://www.brsbox.com/filebox/down/fc/818f8ddf395af42c927d4b2875172365
程序源代码:
Public Class Form1
Public AcadApp As AutoCAD.AcadApplication
Public xx(), yy(), zz() As Double
Public Px(), Py(), Pz() As Double
Public Count As Integer
Public PCount As Integer
Public returnObj As Object
Public myPathLine As Object
Public Sub 启动CAD()
On Error Resume Next
AcadApp = GetObject(, "AutoCAD.Application")
If Err.Number Then
Err.Clear()
AcadApp = CreateObject("AutoCAD.Application")
End If
AcadApp.Visible = True
AcadApp.WindowState = AutoCAD.AcWindowState.acMax
AppActivate(AcadApp.Caption)
End Sub
Public Sub 获取2DPolyline节点坐标(ByVal lineObject As Object) 'AcDbPolyline
ComboBox1.Items.Clear()
Dim i As Integer
For i = 0 To 10000
On Error GoTo handle01
Count = i
ReDim Preserve xx(i)
ReDim Preserve yy(i)
ReDim Preserve zz(i)
xx(i) = lineObject.Coordinate(i)(0)
yy(i) = lineObject.Coordinate(i)(1)
ComboBox1.Items.Add(i)
Next
handle01:
Count = Count - 1
End Sub
Public Sub 获取3DPolyline线节点坐标(ByVal lineObject As Object) 'AcDb3dPolyline
Dim i As Integer
For i = 0 To 1000
On Error GoTo handle01
PCount = i
ReDim Preserve Px(i)
ReDim Preserve Py(i)
ReDim Preserve Pz(i)
Px(i) = lineObject.Coordinate(i)(0)
Py(i) = lineObject.Coordinate(i)(1)
Pz(i) = lineObject.Coordinate(i)(2)
Next
handle01:
PCount = PCount - 1
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Call 启动CAD()
Dim myReturnObj, basePnt As Object
AcadApp.ActiveDocument.Utility.GetEntity(myReturnObj, basePnt)
myReturnObj.highlight(True)
'判断线的类型
Dim LineTypenName As String
LineTypenName = myReturnObj.ObjectName.ToString()
If LineTypenName = "AcDb3dPolyline" Then
Call 获取3DPolyline线节点坐标(myReturnObj)
myPathLine = myReturnObj
Call DoModeling()
Button1.Enabled = False
Else
MsgBox("请确保选取的路径线为3DPolyline线条!" + Chr(13) + "提示:绘制3DPolyline线的命令为3DPoly")
End If
AppActivate(Me.Text)
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Call 启动CAD()
Dim basePnt As Object
AcadApp.ActiveDocument.Utility.GetEntity(returnObj, basePnt)
returnObj.highlight(True)
'判断线的类型
Dim LineTypenName As String
LineTypenName = returnObj.ObjectName.ToString()
If LineTypenName = "AcDbPolyline" And returnObj.Closed Then
'获取选取的剖面线的坐标点
Call 获取2DPolyline节点坐标(returnObj)
Button1.Enabled = True
If CheckBox1.Checked Then
returnObj.Delete()
End If
Else
MsgBox("请确保剖面线为2D的Polyline线且闭合!")
Exit Sub
End If
AppActivate(Me.Text)
End Sub
Public Sub DoModeling()
'沿着X轴旋转这些坐标点90度
Dim i As Integer
For i = 0 To Count
zz(i) = yy(i)
yy(i) = 0
Next
'根据旋转后的坐标绘制面域的来源边界线
Dim PointArray() As Double
ReDim PointArray(3 * (Count + 1) - 1)
For i = 0 To Count
PointArray(3 * i) = xx(i)
PointArray(3 * i + 1) = yy(i)
PointArray(3 * i + 2) = zz(i)
Next
Dim RegionObjects(0 To 0) As AutoCAD.Acad3DPolyline
RegionObjects(0) = AcadApp.ActiveDocument.ModelSpace.Add3DPoly(PointArray)
RegionObjects(0).Closed = True
'移动并旋转边界线
Dim createRegionObjects As Object
Dim createSolidRegion As AutoCAD.AcadRegion
createRegionObjects = AcadApp.ActiveDocument.ModelSpace.AddRegion(RegionObjects)
createSolidRegion = createRegionObjects(0)
Dim movePoint1(0 To 2) As Double
Dim movePoint2(0 To 2) As Double
Dim rotateAngle As Double
movePoint1(0) = xx(ComboBox1.Text) : movePoint1(1) = yy(ComboBox1.Text) : movePoint1(2) = zz(ComboBox1.Text)
If RadioButton1.Checked Then
movePoint2(0) = Px(0) : movePoint2(1) = Py(0) : movePoint2(2) = Pz(0)
rotateAngle = -Math.Atan((Px(1) - Px(0)) / (Py(1) - Py(0)))
Else
movePoint2(0) = Px(PCount) : movePoint2(1) = Py(PCount) : movePoint2(2) = Pz(PCount)
rotateAngle = -Math.Atan((Px(PCount) - Px(PCount - 1)) / (Py(PCount) - Py(PCount - 1)))
End If
createSolidRegion.Move(movePoint1, movePoint2)
If Py(0) = Py(1) Then
GoTo step01
Else
createSolidRegion.Rotate(movePoint2, rotateAngle)
End If
step01:
AcadApp.ActiveDocument.ModelSpace.AddExtrudedSolidAlongPath(createSolidRegion, myPathLine)
RegionObjects(0).Delete()
createSolidRegion.Delete()
If CheckBox2.Checked Then
myPathLine.delete()
End If
End Sub
End Class
- 根据剖面图及路径自动建立模型
- linux 根据文件路径自动创建文件夹
- 根据字符串格式的模型路径获得模型
- 30.avi 【根据用户-角色模型建立实体类】
- starUML建立模型及生成代码框架
- 根据客户端文件路径及服务器保存路径上传文件
- VC 根据文件路径获取设备路径及设备名
- 湿位涡剖面图
- 解析「三户模型」及建立账户模型
- ERwin根据映射文件,自动为物理模型命英文名
- 一个小工具根据json字符串自动创建模型类
- Django根据现有数据库,自动生成models模型文件
- 使用visio建立数据库模型(手动和逆向自动)
- 建立模型
- 根据字符串创建FTP本地目录 并按照日期建立子目录返回路径
- 五、建立语言模型几种方法及使用
- Odoo建立Model(模型)及Form、Tree视图(示例)
- 主键约束自动建立索引问题及约束状态分析
- 获取CAD中线的每个节点坐标程序设计(一)
- 获取CAD中线的每个节点坐标程序设计(二)
- 体绘制(Volume Rendering)概述之1:什么是体绘制?
- 数字测图成果处理——计算开挖量绘制剖面图
- 适合任何CAD版本的CAD开发技巧
- 根据剖面图及路径自动建立模型
- 超链接的写法
- 土石方开挖量计算
- 行列式计算程序设计
- 体绘制(Volume Rendering)概述之2:体数据详解!!!(包括下载网址)
- Java学习之路:不走弯路,就是捷径
- Cholesky分解法
- Crout分解法
- 实模式