急：关于坐标系的问题

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

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

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

急：关于坐标系的问题

发表回复

精选推荐