[求助]图表连接的即时修改

triggerman

里面有更加详细的说明！

triggerman

里面有更加详细的说明！

sharksun

具体没做过，不过感觉不难。


我做过三向光顺（就是一个物体的三视图，改变其中一个视图，另外两个自动变）和cad与excel的交互。开始用的是objectid方法，结果有些问题，后来用扩展数据做的，然后用文档级事件相应。


不难的。

翔羽

TO:sharksun 我现在正在做毕业设计，需要用到cad与excel交互的问题，时间非常紧急！！我看了你发的贴子，上面说到“ 我做过三向光顺（就是一个物体的三视图，改变其中一个视图，另外两个自动变）和cad与excel的交互。开始用的是objectid方法，结果有些问题，后来用扩展数据做的，然后用文档级事件相应。不难的。”请问你能否把代码发给我看看，好好学习。我邮箱是aming800407@sohu.com 十分感谢~~

sharksun

我最近做了个外板展开的小程序(用到高手们编写的vlax类），做了板缝线的交互修改，原理都差不多的。
以下代码你可以参考一下： Private Sub AcadDocument_ObjectModified(ByVal Obj As Object)
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant
Dim intA As Integer
Dim Dis() As Double
Dim pntArray() As Double
Dim SeamNo As Integer

Dim StartTan(0 To 2) As Double
Dim EndTan(0 To 2) As Double

If frm1.ChkInterM.value = True Then

Set ObjCurve = New Curve

Dim xt As Variant, xd As Variant
Dim StrXd As String
Dim xType As Variant, xData As Variant
Obj.GetXData "", xt, xd

Dim Fm1 As Integer, Fm2 As Integer
Fm1 = xd(1): Fm2 = xd(2)

ReDim Dis(Fm1 To Fm2) As Double
ReDim pntArray(0 To (Fm2 - Fm1 + 1) * 3 - 1) As Double
StrXd = Trim(CStr(xd(0)))
SeamNo = CInt(Right(StrXd, Len(StrXd) - 2)) If Left(Trim(xd(0)), 2) = "SS" Then For intK = Fm1 To Fm2 var1 = Obj.IntersectWith(ObjLine(intK), acExtendNone)
var2 = ObjLine(intK).EndPoint Dis(intK) = var1(1) - var2(1)

Set ObjCurve.Entity = ObjFrame(intK)
var3 = ObjCurve.GetPointAtDistance(Dis(intK))

pntArray(intA) = var3(0)
pntArray(intA + 1) = var3(1)
pntArray(intA + 2) = 0
intA = intA + 3

Next intK

SeamFMSpline(SeamNo).Delete 'ɾ³ýÔ­ÏȵÄ
Set SeamFMSpline(SeamNo) = ThisDrawing.ModelSpace.AddSpline(pntArray, StartTan, EndTan)

ElseIf Left(Trim(xd(0)), 2) = "SF" Then
For intK = Fm1 To Fm2

var1 = Obj.IntersectWith(ObjFrame(intK), acExtendNone)
Set ObjCurve.Entity = ObjFrame(intK)
Dis(intK) = ObjCurve.GetDistanceAtPoint(var1)
pntArray(intA) = SelectedFrameDisX(intK)
pntArray(intA + 1) = Dis(intK) + ObjLine(intK).StartPoint
pntArray(intA + 2) = 0
intA = intA + 3
Next intK
ShellSeam(SeamNo).Delete 'ɾ³ýÔ­ÏȵÄ
Set ShellSeam(SeamNo) = ThisDrawing.ModelSpace.AddSpline(pntArray, StartTan, EndTan)

End If
End If End Sub