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 ()<BR>                       On Error Resume Next<BR>                       Dim rotationangle As Double<BR>                               Dim pt1 As Variant<BR>                               Dim pt2 As Variant<BR>                                               Dim pt3 As Variant<BR>                                                       Dim pt4 As Variant<BR>                                                       <BR>                               pt1 = ThisDrawing.Utility.GetPoint(, "请输入第一点：")<BR>                                       pt2 = ThisDrawing.Utility.GetPoint(, "请输入第二点：")<BR>                                               pt3 = ThisDrawing.Utility.GetPoint(, "请选择第一点：")<BR>                                                       pt4 = ThisDrawing.Utility.GetPoint(, "请选择第二点：")<BR>                       Dim SSet As AcadSelectionSet<BR>                       If Not IsNull(ThisDrawing.SelectionSets.Item("this")) Then<BR>                                                       Set SSet = ThisDrawing.SelectionSets.Item("this")<BR>                                                       SSet.Delete<BR>                       End If<BR>                       Set SSet = ThisDrawing.SelectionSets.Add("this")<BR>                       SSet.SelectOnScreen<BR>                       Dim element As AcadEntity<BR>                       For Each element In SSet<BR>                       rotationangle = Atn((pt2(1) - pt1(1)) / (pt2(0) - pt1(0))) - Atn((pt4(1) - pt3(1)) / (pt4(0) - pt3(0)))<BR>                       element.rotate pt3, rotationangle<BR>                       element.Move pt3, pt1<BR>                               element.Update<BR>                       Next<BR>                       SSet.Delete<BR>End Sub<BR>

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, '在多段线上选择一点'<BR>                                Set dmxPolyLineObj = obj<BR>                       basePnt = GetIntersectPntWithDmx(basePnt, dmxPolyLineObj)<BR>


'函数：GetIntersectPntWithDmx


Public Function GetIntersectPntWithDmx(pnt As Variant, PLine As AcadLWPolyline) As Variant<BR>                       Dim lineobj As AcadLine<BR>                       Dim pnt1(0 To 2) As Double, pnt2(0 To 2) As Double<BR>                       Dim intersectVarient As Variant<BR>                       Dim intersectPnt(0 To 2) As Double<BR>                       <BR>               <BR>                                                                                                                       <BR>                       pnt1(0) = pnt(0): pnt1(1) = pnt(1): pnt1(2) = 0:<BR>                       pnt2(0) = pnt(0): pnt1(1) = pnt(1) - 1: pnt1(2) = 0:<BR>                       Set lineobj = ThisDrawing.ModelSpace.AddLine(pnt1, pnt2)<BR>                       intersectVarient = GetIntersectPoint(lineobj, PLine)<BR>                                <BR>                       intersectPnt(0) = intersectVarient(0): intersectPnt(1) = intersectVarient(1): intersectPnt(2) = intersectVarient(2)<BR>                       GetIntersectPntWithDmx = intersectPnt<BR>                       lineobj.Delete<BR>End Function<BR>
页: [1]
查看完整版本: 急：关于坐标系的问题