Private Sub RButton_提取竖曲线_
ItemClick(sender
As Object, e
As DevExpress.XtraBars.
ItemClickEventArgs) Handles RButton_提取竖曲线.
ItemClick
If CmBoxEdit_路线图源_竖曲线.SelectedIndex = -1 Then
XtraMessageBox.Show("请先指定路线所在图纸", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return
End If
If CmBoxEdit_路线名称_竖曲线.SelectedIndex = -1 Then
XtraMessageBox.Show("请先指定路线名称", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return
End If
If String.IsNullOrEmpty(TextEdit_竖曲线切线图层.Text) OrElse String.IsNullOrEmpty(TextEdit_竖曲线图层.Text) Then
XtraMessageBox.Show("请先指定设计图
中的竖曲线及切向线所在图层", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Information)
Return
End If
Dim CivilTag = CType(CmBoxEdit_路线图源_竖曲线.Tag, List(Of (cad文档
As Document, civil文档
As CivilDocument, 文档name
As String, 路线names
As List(Of String), 曲面names
As List(Of String))))
Dim CADdocName
As String = CivilTag.
Item(CmBoxEdit_路线图源_竖曲线.SelectedIndex).文档name
Dim docs = cadApp.DocumentManager
Dim 路线doc
As Document = Nothing
For Each 路线doc In docs
If 路线doc.Name = CADdocName Then Exit For
Next
Dim 当前Doc = cadApp.DocumentManager.MdiActiveDocument
Dim 当前ed
As Editor = 当前Doc.Editor
Dim 当前db
As Datab
ase = 当前Doc.Datab
ase
Dim civilDoc = CivilTag.
Item(CmBoxEdit_路线图源_竖曲线.SelectedIndex).civil文档
Dim AlignIDs = civilDoc.GetAlignmentIds
Dim civilDB = 路线doc.Datab
ase
Dim allEnts
As New List(Of CAD.Entity)
Dim 竖曲线PL
As New CAD.Polyline()
Dim 切线PL
As New CAD.Polyline()
Using 当前tr
As Transaction = 当前db.TransactionManager.StartTransaction
&#
39;== 同图层所有符合类型实体 =============================
Dim filter
As New SelectionFilter({
New TypedValue(-4, "<AND"),
New TypedValue(0, "*POLYLINE"),
New TypedValue(-4, "<OR"), New TypedValue(8, TextEdit_竖曲线图层.Text), New TypedValue(8, TextEdit_竖曲线切线图层.Text), New TypedValue(-4, "OR>"),
New TypedValue(-4, "AND>")
})
Dim ssres
As PromptSelectionResult = 当前ed.SelectAll(filter)
If ssres.Status <> PromptStatus.OK Then
XtraMessageBox.Show("未在指定的竖曲线及切向线图层中找到任何图元", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If
allEnts = ssres.Value.GetObjectIds().
Select(Function(id) CType(当前tr.GetObject(id, OpenMode.ForRead), CAD.Entity)).
ToList()
Dim 竖曲线Ents = allEnts.Where(Function(ent) ent.Layer = TextEdit_竖曲线图层.Text).ToList()
Dim 切线Ents = allEnts.Where(Function(ent) ent.Layer = TextEdit_竖曲线切线图层.Text).ToList()
&#
39;将竖曲线按起点坐标从左至右排序
竖曲线Ents = 竖曲线Ents.OrderBy(Function(ent)
If TypeOf ent Is CAD.Polyline Then
Return CType(ent, CAD.Polyline).StartPoint.X
Else
Return CType(ent, CAD.Polyline2d).StartPoint.X
End If
End Function).ToList
If 竖曲线Ents.Count = 0 Then
XtraMessageBox.Show("未在指定的竖曲线图层中找到任何图元", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If
&#
39;将切线按起点坐标从左至右排序
切线Ents = 切线Ents.OrderBy(Function(ent)
If TypeOf ent Is CAD.Polyline Then
Return CType(ent, CAD.Polyline).StartPoint.X
Else
Return CType(ent, CAD.Polyline2d).StartPoint.X
End If
End Function).ToList
If 切线Ents.Count = 0 Then
XtraMessageBox.Show("未在指定的切线图层中找到任何图元", "提示：", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return
End If
竖曲线PL = 多段线首尾相连(竖曲线Ents)
切线PL = 多段线首尾相连(切线Ents)
当前tr.Commit()
End Using
cadApp.DocumentManager.CurrentDocument = CivilTag.
Item(CmBoxEdit_路线图源_竖曲线.SelectedIndex).cad文档
&#
39;cadApp.DocumentManager.MdiActiveDocument = CivilTag.
Item(CmBoxEdit_路线图源_竖曲线.SelectedIndex).cad文档
Using c
3dTr
As Transaction = civilDB.TransactionManager.StartTransaction
Dim layerName
As String = "OCDS_纵断面图"
Dim layerID = GetLayerId(civilDB, layerName, 5)
Dim al
As C
3D.Alignment = Nothing
Dim ALname
As String = If(CmBoxEdit_路线名称_竖曲线.EditValue, "")
For Each id
As ObjectId In AlignIDs
al = c
3dTr.GetObject(id, OpenMode.ForRead)
If al.Name = ALname Then
Exit For
Else
al = Nothing
End If
Next
If al IsNot Nothing Then
#Region " 创建纵断面"
Dim styleID
As ObjectId
If civilDoc.Styles.ProfileStyles.Contains("设计线") Then
styleID = civilDoc.Styles.ProfileStyles("设计线")
Else
styleID = civilDoc.Styles.ProfileStyles(0)
End If
Dim labelSetID
As ObjectId
If civilDoc.Styles.LabelSetStyles.ProfileLabelSetStyles.Contains("标准") Then
labelSetID = civilDoc.Styles.LabelSetStyles.ProfileLabelSetStyles("标准")
Else
labelSetID = civilDoc.Styles.LabelSetStyles.ProfileLabelSetStyles(0)
End If
&#
39; 获取现有纵断面名称
Dim existingNames
As New H
ashSet(Of String)(StringComparer.OrdinalIgnoreC
ase)
For Each Id
As ObjectId In al.GetProfileIds
Dim ProfileObj = CType(c
3dTr.GetObject(Id, OpenMode.ForRead), C
3D.Profile)
existingNames.Add(ProfileObj.Name)
Next
&#
39; 生成唯一纵断面名称
Dim ProfileName
As String = GenerateUniqueProfileName(TextEdit_竖曲线命名.EditValue, existingNames)
&#
39; 创建纵断面
Dim oProfileId = C
3D.Profile.CreateByLayout(ProfileName, al.ObjectId, layerID, styleID, labelSetID)
Dim oProfile
As Profile = c
3dTr.GetObject(oProfileId, OpenMode.ForRead)
Dim ZdmEnts = oProfile.Entities
#End Region
&#
39; 设置插入点
Dim ptInsert = CalculateInsertionPoint(al)
&#
39; 处理比例和缩放
ProcessScaling(切线PL, 竖曲线PL)
&#
39; 添加切线到纵断面
Dim jds = AddTangentsToProfile(切线PL, ZdmEnts, ptInsert)
&#
39; 添加竖曲线到纵断面
AddVerticalCurvesToProfile(竖曲线PL, oProfile, ZdmEnts, jds, ptInsert)
&#
39; 创建纵断面视图
CreateProfileView(al, ptInsert, c
3dTr)
c
3dTr.Commit()
End If
End Using
End Sub
执行到Dim oProfileId = C
3D.Profile.CreateByLayout(ProfileName, al.ObjectId, layerID, styleID, labelSetID)报错值不在预期范围内，我确定ProfileName与存在的纵断面名称均不相同，al、layer、style、labelSet实际存在
本文介绍了如何在 selectableList 的 itemclick 事件中获取被点击项的数据。通过添加事件监听器并在事件处理函数中使用 e.item.ID 获取所需数据。
扫一扫
1292
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
