Keith™ 发表于 2007-9-11 07:03:32

更新行

我有一个vba模块,允许用户选择一条线。然后交换端点以反转线#039;s方向。但是,当我更新线时,图形窗口中的方向不会反转,尽管在VBA Manager中是这样;我加了一条线来改变颜色,当这条线更新时就可以了 与I'我也在努力
有什么想法吗?

Bryco 发表于 2007-9-11 07:53:06

你能发布一些代码吗?

Bryco 发表于 2007-9-11 09:49:05

看起来是这样的:
Attribute VB_Name = "RichtungAendern"
Option Explicit
'Attribute VB_Name = "Richtung Ändern"
'Reverse line direction - German Version
Sub RichtungAendern()
    Dim objLineEnt As AcadEntity
    Dim txtEnt As AcadText
    Dim linEnt As AcadLine
    Dim orgLineAngle As Double
    Dim varSelPoint As Variant
    Dim linAngle As Double
    Dim PI As Double
    Dim varLineStart As Variant
    Dim varLineEnd As Variant
    Dim varTemp As Variant
    'initialise variables
    varSelPoint = 0#
    'get a line
    Do
      On Error Resume Next
START:
      ThisDrawing.Utility.GetEntity objLineEnt, varSelPoint, "eine Linie wählen"
            Dim entName As String
            entName = objLineEnt.ObjectName
      
      'only process if a line was selected
      If objLineEnt.ObjectName = "AcDbLine" Then
            varLineStart = objLineEnt.StartPoint
            varLineEnd = objLineEnt.EndPoint
            varTemp = varLineStart
            varLineStart = varLineEnd
            varLineEnd = varTemp
            objLineEnt.color = acRed
            objLineEnt.Update
      Else    'inform user that no line was selected
            MsgBox ("das war keine Linie!" & vbCr & "Bitte eine Linie wählen")
            GoTo START
      End If
    Loop    'go back and get another line
End Sub
_____u_ _NU_NU _ _它将线条颜色更新为红色,但不交换端点。

Bryco 发表于 2007-9-11 10:02:16


            varLineStart = objLineEnt.StartPoint
            varLineEnd = objLineEnt.EndPoint
            objLineEnt.StartPoint = varLineEnd
            objLineEnt.EndPoint = varLineStart
            objLineEnt.color = acRed
            objLineEnt.Update

Bryco 发表于 2007-9-11 10:41:55

嗨,基思,就是这样 谢谢
I'现在我们来试试折线。

Bryco 发表于 2007-10-15 13:45:07

普林甚至不可能实现同样的功能 对于基准线,您必须获取坐标列表,反转列表,绘制新基准线并删除旧基准线 对于ACADLWPolylines和ACADPolyline,它也必须不同 以及#039;s假设所有选定的多段线都由直线段组成 如果它有任何曲线,乐趣将真正开始。

Bryco 发表于 2007-10-15 19:54:46

鲍勃,很高兴再次收到你的来信
现在我知道你的说法对acad 2000是正确的,但在2008年试试这个Sub SwapEnds(P As AcadLWPolyline)
    Dim P As AcadLWPolyline
    Dim C1, C2
    C1 = P.Coordinate(1)
    C2 = P.Coordinate(0)
    P.Coordinate(0) = C1
    P.Coordinate(1) = C2
End Sub 它在一条直线上交换端点
页: [1]
查看完整版本: 更新行