急：关于坐标系的问题

awei

问题如下：



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

雪山飞狐_lzh

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

河伯

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

awei

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


        点在垂直方向上和多断线的交点

cqy

这里有统一坐标的程，在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

cqy：对不起，我不太理解rotationangle的作用，能解释一下最后几句话的意义吗。


版主：随心飘荡:你好：有这种情况，getentity中的basepnt的值不是WCS的

雪山飞狐_lzh

[WEB]http://www.vba.cn/object/acad2004/idh_getentity.htm[/WEB]

awei

我在看看，怎么和我印象中的结果不一致，


谢谢随心飘荡

awei

请帮忙看一看代码哪里出现了问题： 要求用户在多段线上选择一点，然后找到该点在垂直方向上和多段线的交点，但是提示找不到交点：在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