在南方CASS7.1软件如何把己有图形的拐点坐标自动生成？_百度知道
在南方CASS7.1软件如何把己有图形的拐点坐标自动生成？
我有更好的答案
按默认排序
【地籍】菜单--【界址点生成数据文件】。1。就是使用CASS的地籍的界址点功能。还有其他的方法。2，里面就有你需要的拐点坐标咯，选择上一步得到的界址线.【地籍】菜单--【复合线转为权属线】，就可以保存为CASS格式的坐标文件DAT了，把你由复合线绘制的图形暂时转换为权属线使用LIST列表命令也可以
兄弟，我们干测量的不能太懒，一个一个的点吧，又不要你输！如果是多段线的话用LIST这个命令，每个节点的坐标都出来了，呵呵
呵呵，我有软件！
其他类似问题
在南方的相关知识
等待您来回答
下载知道APP
随时随地咨询
出门在外也不愁南方CASS7[1].0标准电子教程另有视频教程_百度文库
两大类热门资源免费畅读
续费一年阅读会员，立省24元！
文档贡献者贡献于
评价文档：
104页免费104页免费104页免费104页1下载券80页免费 104页1下载券104页免费104页2下载券1页免费104页2下载券
喜欢此文档的还喜欢80页1下载券32页1下载券2页免费25页免费104页1下载券
南方CASS7[1].0标准电子教程另有视频教程|很​经​典​ ​的​视​频​电​子​教​程
把文档贴到Blog、BBS或个人站等：
普通尺寸(450*500pix)
较大尺寸(630*500pix)
大小：8.58MB
登录百度文库，专享文档复制特权，财富值每天免费拿！
你可能喜欢 下载
 收藏
该文档贡献者很忙，什么也没留下。
 下载此文档
正在努力加载中...
一种界址表和界址点坐标成果表的自动生成方法
下载积分：600
内容提示：近红外等效光谱测量方法研究——精品论文
文档格式：PDF|
浏览次数：1|
上传日期： 20:45:17|
文档星级：
该用户还上传了这些文档
下载文档:一种界址表和界址点坐标成果表的自动生成方法.PDF
官方公共微信CASS&界址点成果表3
'——————————————————————————————————————
'名称：InsertJZDCGB
'作者：罗简单
'功能：为程序添加界址点成果表
'——————————————————————————————————————
Public Sub InsertJZDCGB(pBasePt As Variant, ByVal strName As
& Dim strPath As String
& strPath = "D:\Program Files\CASS70\BLOCKS\"
& strName & ".dwg"
& Dim pBlock As AcadBlockReference
& Set pBlock =
ThisDrawing.ModelSpace.InsertBlock(pBasePt, strPath, 1, 1, 1,
& pBlock.Update
'—————————————————————————————————————
'名称：ReadFileLine
'作者：罗简单
'功能：读取文本文件指定行的内容，以及总行数
'—————————————————————————————————————
Public Function ReadFileLine(fFile As String, numLine As
Integer) As String
& Dim i As Integer
& Dim myFSO As New FileSystemObject, myFile As
File, myTs As TextStream
& Set myFile = myFSO.GetFile(fFile)
& Set myTs =
myFile.OpenAsTextStream(ForReading)
& Do While Not myTs.AtEndOfStream
&& numLine Then
myTs.ReadLine
ReadFileLine = myTs.ReadLine
&&& End If
&&& i = i +
& Set myTs = Nothing
End Function
'——————————————————————————————————————
'名称：ReadJzdInfo_To_Txt
'作者：罗简单
'功能：将宗地从左上角开始，顺时针读取界址点信息到文本文件
'——————————————————————————————————————
Public Sub ReadJZDINFO_To_Txt(pLwpObj As AcadLWPolyline)
& Dim gType, gData
& pLwpObj.GetXData "SOUTH", gType, gData
& Dim strDJH As String
& strDJH = gData(2)
& Dim myPointlist As Variant
& myPointlist = Pt2wTo3w(pLwpObj)
& Dim pType, pData
& BuildFilter pType, pData, 0, "Circle", 8,
& Dim sset As AcadSelectionSet
& Set sset = CreateSelectionSet2
& '建立选择集
& sset.Clear
& sset.SelectByPolygon acSelectionSetFence,
myPointlist, pType, pData
& Dim strData As String
& Dim tmpData As String
& Dim numVer As Integer
& Dim i As Integer&
'循环Index
& Dim pCirObj As AcadCircle
& Dim cenPt As Variant
& numVer = (UBound(pLwpObj.Coordinates) + 1) / 2 -
& Dim intWNVer As Integer&
& intWNVer = TheLeftTopVer(pLwpObj)
& If IsClockWise(pLwpObj) Then&
&&& If intWNVer
= 0 Then '第一个点
'循环界址点
For Each pCirObj In sset
ReadJZDINFO pCirObj
Next pCirObj
Set pCirObj = sset.Item(0)
ReadJZDINFO pCirObj
&&& ElseIf
intWNVer = numVer Then '最后一个点
'先读取最后一个点
Set pCirObj = sset.Item(numVer)
ReadJZDINFO pCirObj
'在从头读到尾
For Each pCirObj In sset
ReadJZDINFO pCirObj
Next pCirObj
Else& '左上角不是首、尾点
'从左上角读到尾部
For i = intWNVer To numVer
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
'再从头读到左上角
For i = 0 To intWNVer
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
&&& End If
& Else& '逆时针
&&& If intWNVer
= 0 Then& '如果坐上角为第一个点
'先读取第一个点
Set pCirObj = sset.Item(0)
ReadJZDINFO pCirObj
'再从尾读到头
For i = numVer To 0 Step -1
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
&&& ElseIf
intWNVer = numVer Then '如果左上角为最后一个点
'先从尾读到头
For i = numVer To 0 Step -1
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
Set pCirObj = sset.Item(numVer)
ReadJZDINFO pCirObj
Else& '如果左上角既不为第一个点也不为最后一个点
'先从左上角读到头
For i = intWNVer To 0 Step -1
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
'再从尾读到左上角
For i = numVer To intWNVer Step -1
Set pCirObj = sset.Item(i)
ReadJZDINFO pCirObj
&&& End If
Public Sub ReadJZDINFO(pCirObj As AcadCircle)
& Dim cenPt As Variant
& Dim strData As String
& Dim gType, gData
& cenPt = pCirObj.Center
& '获取界址点号
& pCirObj.GetXData "SOUTH", gType, gData
& strData = ""
& strData = Trim(str(gData(3))) &
"," & Format(cenPt(1), "0.000") &
"," & Format(cenPt(0), "0.000")
& Open "C:\JZDCGB.txt" For Append As #1
&&& Print #1,
& Close #1
Sub testReadJzdin()
& Dim p As AcadEntity
& Dim pp As Variant
& ThisDrawing.Utility.GetEntity p, pp
& ReadJZDINFO_To_Txt p
'————————————————————————————————————
'名称：TheLeftTopVer
'作者：罗简单
'功能：查找多段线最左上角节点的坐标
'原理：先得到最小矩形，然后判断每一个节点到最小矩形的下边和右边距离和
和最大的就是最左上角的点
'————————————————————————————————————
Public Function TheLeftTopVer(ByVal pLwpObj As AcadLWPolyline) As
& Dim extMin, extMax
& pLwpObj.GetBoundingBox extMin, extMax
& Dim numVer As Integer
& numVer = (UBound(pLwpObj.Coordinates) + 1) /
& '先取第一个节点到最小矩形的距离
& Dim tmpVer As Variant
& tmpVer = pLwpObj.Coordinate(0)
& Dim pDis As Double
& Dim pTmp_Dis As Double
& Dim No_LeftTop As Integer
& pDis = Abs((tmpVer(0) - extMax(0))) +
Abs((tmpVer(1) - extMin(1)))
& No_LeftTop = 0
& Dim i As Integer
& '循环每一个节点
& For i = 1 To numVer - 1
&&& tmpVer =
pLwpObj.Coordinate(i)
&&& pTmp_Dis =
Abs((tmpVer(0) - extMax(0))) + Abs((tmpVer(1) - extMin(1)))
&&& If pTmp_Dis
& pDis Then
pDis = pTmp_Dis
No_LeftTop = i
&&& End If
& TheLeftTopVer = No_LeftTop
End Function
'——————————————————————————————————————
'名称：IsClockWise
'作者：罗简单
'功能：判断一个多段线节点的方向是否为顺时针。
'——————————————————————————————————————
Public Function IsClockWise(ByVal pLwpObj As AcadLWPolyline) As
& IsClockWise = False '初始化，多段线节点旋转方向为逆时针
& Dim pLwpObj_Offset As AcadLWPolyline
& Dim varOffset As Variant
& varOffset = pLwpObj.Offset(2)
& Set pLwpObj_Offset = varOffset(0)
& Dim Area As Double, Area_Offset As Double
& Area = pLwpObj.Area: Area_Offset =
pLwpObj_Offset.Area
& If Area_Offset & Area Then
&&& IsClockWise
&&& IsClockWise
& pLwpObj_Offset.Delete
End Function
'****************************************************************
'名称：Pt2wTo3w
'作者：罗简单
'功能：将多段线的二维坐标转三维坐标的函数，三维坐标中Z值为0
'目的：在使用selectbypolygon方法时，要求的坐标组必须是三维的。
'****************************************************************
Public Function Pt2wTo3w(ByVal Lwp As AcadLWPolyline) As
'Lwp坐标集
Dim CoorLwp As Variant
&&& CoorLwp =
Lwp.Coordinates
'坐标个数，二维坐标
Dim k As Integer
UBound(CoorLwp) + 1
'把二维坐标转为三维坐标，但Z值为0
Dim c As Integer
&&& c = k * 3 /
Dim points() As Double '定义动态坐标点
ReDim points(0 To c) As Double
'二维坐标转换成三位坐标
'例如：(12.34,35.67)转换成(12.34,35.67,0)
Dim g As Integer, v As Integer
For g = 0 To k - 1
&&& v = g \
&&& points(g +
v) = CoorLwp(g)
&&& Pt2wTo3w =
End Function
'创建过滤器的函数
Public Sub BuildFilter(TypeArray, DataArray, ParamArray
&&& Dim fType()
As Integer, fData()
&&& Dim index As
Long, i As Long
&&& index =
LBound(gCodes) - 1
&&& For i =
LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
&&& TypeArray =
fType: DataArray = fData
'创建空间选择集的函数
Public Function CreateSelectionSet(Optional ssName As String =
"ss") As AcadSelectionSet
&&& Dim ss As
AcadSelectionSet
&&& On Error
Resume Next
&&& Set ss =
ThisDrawing.SelectionSets(ssName)
&&& If Err Then
Set ss = ThisDrawing.SelectionSets.Add(ssName)
CreateSelectionSet = ss
End Function
'创建空间选择集的函数2
Public Function CreateSelectionSet2(Optional ssName As String =
"ss2") As AcadSelectionSet
&&& Dim ss2
As AcadSelectionSet
&&& On Error
Resume Next
&&& Set ss2 =
ThisDrawing.SelectionSets(ssName)
&&& If Err Then
Set ss2 = ThisDrawing.SelectionSets.Add(ssName)
CreateSelectionSet2 = ss2
End Function
'创建距离函数
Public Function Distance(x0 As Variant, x1 As Variant, y0 As
Variant, y1 As Variant) As Double
&& Dim d As Double
&& d = Sqr((x0 - x1) ^ 2 + (y0 -
&& Distance = d
End Function
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。}