Civil 3D表面处理帮助！
我正在寻找一些帮助，帮助我们在Civil 3D 2008中实现曲面创建过程的自动化。不幸的是，我在编码方面相当笨，所以这并不像我想象的那样是一个简单直接的过程我已经使用开发人员指南对示例代码进行了一些研究，但没有任何结果
我设想这段代码的作用是：
1）要求用户选择要素线#1（FL1）
2）要求用户选中要素线＃2（FL2）
3）创建一个新的三角网曲面
，名称为Bldg 001（随着每个附加曲面的增加，数字会增加）图层“曲面BLDG”（在图形中作为默认三角网曲面图层存在）对于曲面样式“建筑曲面”（也是默认曲面样式）
4），曲面将通过首先添加FL1作为标准特征线来“构造”。第二，将添加FL2作为标准特征线，最后，将再次添加FL2，但这次是作为非破坏性边界
就这样-然后打开选择下两条要素线以创建下一个曲面（Bldg 002）。听起来不太复杂，但我一辈子都想不出来
这是我到目前为止汇编的代码-几乎都是从开发人员指南中盗取的
(vl-load-com)
(setq AcadObject (vlax-get-acad-object))
(setq ActDoc (vla-get-activedocument AcadObject))
;;
;;
;; CODE TO CREATE SELECTION SET FL1 FOR EXTERIOR FEATURE LINE
;;
;;
Sub Ch4_CreateSelectionSet()
Dim selectionset1 as AcadSelectionSet
Set selectionset1 = ThisDrawing.SelectionSets.Add("FL1")
selectionset1.SelectOnScreen
End Sub
;;
;;
;; CODE TO CREATE SELECTION SET FL2 FOR INTERIOR FEATURE LINE
;;
;;
Sub Ch4_CreateSelectionSet()
Dim selectionset2 as AcadSelectionSet
Set selectionset2 = ThisDrawing.Selectionsets.Add("FL2")
selectionset2.SelectOnScreen
End Sub
;; CODE TO CREATE NEW SURFACE:
;;
;;
Dim TinSurface As AeccTinSurface
Dim Tindata as New AeccTinCreationData
TinData.Name = "Bldg Test" ;SET NAME OF SURFACE TO "BLDG"
;; need to add counter system for surface #
TinData.Description = "Building Surface from CPP Building datum" ;SET SURFACE DESCRIPTION
TinData.Layer = "Surface Bldgs" ;SET SURFACE LAYER
TinData.BaseLayer = "Surface Bldgs" ;NOT SURE WHAT THIS DOES
TinData.Style = "Building Surfaces" ;SET SURFACE STYLE
Set Tinsurface = AeccDocument.Surfaces.AddTinSurface(TinData) ;NOT SURE WHAT THIS DOES
;;
;;
;; CODE TO ADD THE EXTERIOR FEATURE LINE (FL1) AS A NON-DESTRUCTIVE BREAKLINE CODE TO THE SURFACE
;;
;;
set 3DPoly = AeccDocument.Database.Modelspace.Add3DPoly(dPoints)
3dPoly.Closed = False
Dim Breakline As AeCCSurfaceBreakline
Dim vBLines as Variant
Dim EntityArray(0) as AcadEntity
Set EntityArray(0) = AeccDocument.Database.ModelSpace.Add3DPoly(dPoints)
Set Breakline = TinSurface.Breaklines.AddNonDestructiveBreakline(EntityArray,"Exterior Non-Destructive Breakline", 1#)
;;
;;
;; ADD THE INTERIOR FEATURE LINE (FL2) AS A STANDARD BREAKLINE TO THE SURFACE(S1)
;;
;;
set 3DPoly = AeccDocument.Database.Modelspace.Add3DPoly(dPoints)
3dPoly.Closed = False
Dim Breakline As AeCCSurfaceBreakline
Dim vBLines as Variant
Dim EntityArray(0) as AcadEntity
Set EntityArray(0) = AeccDocument.Database.Modelspace.Add3DPoly
Set Breakline = TinSurface.Breaklines.AddStandardBreakline(EntityArray, "Exterior Boundary", 1#)
Dim EntityArray(0) as AcadEntity
Set EntityArray(0) = AeccDocument.Database.ModelSpace.Add3DPoly(dPoints)
Set Breakline = TinSurface.Breaklines.AddStandardBreakline(EntityArray, "Interior Breakline", 1#)
;;
;;
;; ADD THE EXTERIOR FEATURE LINE (FL1) AS A NON-DESTRUCTIVE BOUNDARY TO THE SURFACE(S1)
;;
;;
Dim Poly As AcadPolyline
Set Poly = AeccDocument.Database.ModelSpace.AddPolyLine(dPoints)
Poly.Closed = True
Dim sName as String
sName = "Surface Boundary"
Dim NewBoundary as AeccSurfaceBoundary
Set NewBoundary = Surface.Boundaries.Add(Poly, Sname, aeccBoundaryOuter, True, 0.5)
有人能帮忙吗
**** Hidden Message ***** 抱歉，我没有软件来玩。 在添加到曲面之前，是否可以发布具有柱基线的样例图形以及所需结果（使用不同的柱基线）。您的代码似乎在创建不必要的对象……但这可能是您想要的。 如果这段代码不符合你的预期，那么我需要你张贴那幅画。然而，我认为这是你想要的。注意，这里只是使用了一个通用的错误陷阱，我强烈建议做一些更健壮的事情.....
您将需要确保在VBA项目中设置Civil Land & LandUI参考。
Sub test()
Dim oApp As AeccApplication
Dim oDoc As AeccDocument
Dim oSurfs As AeccSurfaces
Set oApp = Application.GetInterfaceObject("AeccXUiLand.AeccApplication.5.0")
Set oDoc = oApp.ActiveDocument
Set oSurfs = oDoc.Surfaces
Dim Tindata As New AeccTinCreationData
Tindata.Description = "Building Surface from CPP Building datum" 'SET SURFACE DESCRIPTION
Tindata.Layer = "Surface Bldgs" 'SET SURFACE LAYER
Tindata.BaseLayer = "Surface Bldgs" 'NOT SURE WHAT THIS DOES
Tindata.Style = "Building Surfaces" 'SET SURFACE STYLE
Dim osurf As AeccSurface
Dim iCount As Integer
For Each osurf In oSurfs
If osurf.Name Like "Bldg ###" Then
Dim iTmp As Integer
iTmp = CInt(Right(osurf.Name, 3))
If iTmp > iCount Then iCount = iTmp
End If
Next
Dim sCurName As String
Dim oEnt1 As AcadEntity
Dim oEnt2 As AcadEntity
Dim vPick As Variant
Dim oPoly1 As Acad3DPolyline
Dim opoly2 As Acad3DPolyline
Dim oEnts(0) As AcadEntity
Do Until Err.Number0
iCount = iCount + 1
sCurName = "Bldg " & Format(iCount, "000")
On Error GoTo ResumeHere
ThisDrawing.Utility.GetEntity oEnt1, vPick, vbCr & "Select inside pline: "
Set oPoly1 = oEnt1
ThisDrawing.Utility.GetEntity oEnt2, vPick, vbCr & "Select outside pline: "
Set opoly2 = oEnt2
Tindata.Name = sCurName
Dim oTinSurf As AeccTinSurface
Set oTinSurf = oSurfs.AddTinSurface(Tindata)
Set oEnts(0) = oPoly1
oTinSurf.Breaklines.AddStandardBreakline oEnts, "Interior Breakline", 0.5
Set oEnts(0) = opoly2
oTinSurf.Breaklines.AddStandardBreakline oEnts, "Exterior Breakline", 0.5
oTinSurf.Boundaries.Add opoly2, "Exterior Boundary", aeccBoundaryOuter, True, 0.5
ResumeHere:
'If Err Then MsgBox Err.Description ''uncomment to test for the error thrown
Loop
End Sub
杰夫-非常感谢你的帮助。
对于您的代码，我目前在下面一行出错:
Set oApp = Application.GetInterfaceObject("AeccXUiLand.AeccApplication.5.0")
我附上了一张图纸，希望它能更好地解释我想做的事情。我需要使用两条要素线作为特征线，然后使用外部要素线作为边界来构建曲面。我用的是Civil 3D 2008，如果这有什么不同的话。 一些要看的东西....
首先，抛出的错误是什么？我也在用2008-SP2，你有安装任何SP的吗？
其次，我看到您的绘图有特征线。API中有一个错误/缺陷(是的，Adesk已经记录了该错误/缺陷),不允许我们使用要素线添加特征线。一种解决方法是使用lisp (vlax-curve-*)函数提取每个PI的坐标并创建一个临时3dpoly。另一种方法是首先分解要素线，从而留下3dpoly(如果FL的PI具有不同的高程),或者LWPoly(如果PI都相同)(这也不能在代码中完成，因为在FL的API中没有暴露任何内容)。
我附上适合我的DVB，您的绘图的FL已分解。 杰夫，
现在我加载了你最新的DVB文件，一切都很好
我担心功能线可能会导致问题，但我可以解决这个问题。我喜欢使用功能行来实现其动态更新功能，但您的代码节省的时间比使用功能行的动态功能节省的时间要多得多。在使用要素线更新曲面的罕见情况下，我们现在可以简单地重新创建曲面定义
马克 不客气，马克！很高兴我能帮忙。
请记住在任何较新版本中测试是否可以使用功能线。由于Adesk知道这个问题，因此很有可能在下一个或两个版本中得到解决。要进行测试，只需注释掉2行，3行代码部分，然后更改引用和接口对象。（我们不知道这些在未来的版本中会是什么，但如果历史是任何指标，那么我敢打赌2009年的版本将使用Land 6.0。但这还有很长的路要走...
好了，2009年就到了，唉，作为我的代码管理员，我无法再运行这段代码了。我更改了行：
Set oApp = Application.GetInterfaceObject("AeccXUiLand.AeccApplication.5.0")
现在改为：
Set oApp = Application.GetInterfaceObject("AeccXUiLand.AeccApplication.6.0")
我得到一个运行时错误“13”-类型不匹配
欢迎回来，马克。
我只能推测您可能安装了2008和2009，并且没有在“工具/参考”下更改参考以反映2009版本。因此，当您将oApp设置为AeccApplication时，它会尝试使用2008库，但随后会尝试将其设置为2009版本。
页:
[1]
2