社区 › VB › 急：关于坐标系的问题

awei 发表于 2005-4-8 14:40:00

急：关于坐标系的问题

问题如下：         图形中已经包含一条多段线，但是由于坐标系不同，属性中的显示坐标值和corridates取得的值不同，此时，我要让用户选择一点，然后找到该点和多段线的交点，由于坐标系不同，用户选择点的位置是用户坐标系的值，而据此值画线使用的是wcs，所以找不到和多段线的交点，但是如果wcs和用户坐标系一致，就可以了。应该怎么解决这类问题呢，现在如果坐标的值一致，程序没有问题，可是不一致，一点都干不了。

雪山飞狐_lzh 发表于 2005-4-8 21:42:00

VBA下获得的点都是WCS下的，没有你说的那种情况

河伯 发表于 2005-4-9 23:43:00

"点和多段线的交点"怎么理解？

awei 发表于 2005-4-21 14:26:00

点和多段线的交点"怎么理解？
      点在垂直方向上和多断线的交点

cqy 发表于 2005-4-21 14:39:00

这里有统一坐标的程，在1：1000条件下运行，希望对你有帮助。
        Sub ()
                       On Error Resume Next
                       Dim rotationangle As Double
                               Dim pt1 As Variant
                               Dim pt2 As Variant
                                               Dim pt3 As Variant
                                                       Dim pt4 As Variant
                                                       
                               pt1 = ThisDrawing.Utility.GetPoint(, "请输入第一点：")
                                       pt2 = ThisDrawing.Utility.GetPoint(, "请输入第二点：")
                                               pt3 = ThisDrawing.Utility.GetPoint(, "请选择第一点：")
                                                       pt4 = ThisDrawing.Utility.GetPoint(, "请选择第二点：")
                       Dim SSet As AcadSelectionSet
                       If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then
                                                       Set SSet = ThisDrawing.SelectionSets.Item("this")
                                                       SSet.Delete
                       End If
                       Set SSet = ThisDrawing.SelectionSets.Add("this")
                       SSet.SelectOnScreen
                       Dim element As AcadEntity
                       For Each element In SSet
                       rotationangle = Atn((pt2(1) - pt1(1)) / (pt2(0) - pt1(0))) - Atn((pt4(1) - pt3(1)) / (pt4(0) - pt3(0)))
                       element.rotate pt3, rotationangle
                       element.Move pt3, pt1
                               element.Update
                       Next
                       SSet.Delete
End Sub

awei 发表于 2005-4-21 15:50:00

cqy：对不起，我不太理解rotationangle的作用，能解释一下最后几句话的意义吗。
版主：随心飘荡:你好：有这种情况，getentity中的basepnt的值不是WCS的

雪山飞狐_lzh 发表于 2005-4-21 18:27:00

http://www.vba.cn/object/acad2004/idh_getentity.htm

awei 发表于 2005-4-22 14:11:00

我在看看，怎么和我印象中的结果不一致，
谢谢随心飘荡

awei 发表于 2005-4-30 14:34:00

请帮忙看一看代码哪里出现了问题：
要求用户在多段线上选择一点，然后找到该点在垂直方向上和多段线的交点，但是提示找不到交点：在debug状态下。basepnt的值为2230.24，-85；dmxPolyLineObj的Cooridinates的值横坐标在4700以上，纵坐标的值在153左右，所以找不到交点，为什么会发生这种情况。应该怎么解决？
ThisDrawing.Utility.GetEntity obj, basePnt, '在多段线上选择一点'
                                Set dmxPolyLineObj = obj
                       basePnt = GetIntersectPntWithDmx(basePnt, dmxPolyLineObj)
'函数：GetIntersectPntWithDmx
Public Function GetIntersectPntWithDmx(pnt As Variant, PLine As AcadLWPolyline) As Variant
                       Dim lineobj As AcadLine
                       Dim pnt1(0 To 2) As Double, pnt2(0 To 2) As Double
                       Dim intersectVarient As Variant
                       Dim intersectPnt(0 To 2) As Double
                       
               
                                                                                                                       
                       pnt1(0) = pnt(0): pnt1(1) = pnt(1): pnt1(2) = 0:
                       pnt2(0) = pnt(0): pnt1(1) = pnt(1) - 1: pnt1(2) = 0:
                       Set lineobj = ThisDrawing.ModelSpace.AddLine(pnt1, pnt2)
                       intersectVarient = GetIntersectPoint(lineobj, PLine)
                               
                       intersectPnt(0) = intersectVarient(0): intersectPnt(1) = intersectVarient(1): intersectPnt(2) = intersectVarient(2)
                       GetIntersectPntWithDmx = intersectPnt
                       lineobj.Delete
End Function

查看完整版本: 急：关于坐标系的问题