|
|
发表于 2014-9-17 19:58:00
|
显示全部楼层
returnPnt = acadAPP.ActiveDocument.Utility.GetPoint(, "请拾取原点")
acadAPP.ActiveDocument.Utility.GetEntity returnOb0j, basePnt0, "拾取中桩桩号"
If returnOb0j.ObjectName = "AcDbText" Then
Dim str0GC As Double
str0GC = CDbl(returnOb0j.TextString)
returnOb0j.Color = acBlue
End If
acadAPP.ActiveDocument.Utility.GetEntity returnObj, basePnt1, "拾取中桩高程"
If returnObj.ObjectName = "AcDbText" Then
Dim strGC As Double
strGC = CDbl(returnObj.TextString)
returnObj.Color = acRed
End If origin(0) = returnPnt(0): origin(1) = returnPnt(1): origin(2) = 0
xAxisPnt(0) = origin(0) + 1: xAxisPnt(1) = origin(1): xAxisPnt(2) = 0
yAxisPnt(0) = origin(0): yAxisPnt(1) = origin(1) + 1: yAxisPnt(2) = 0
Set ucsOBJ = acadAPP.ActiveDocument.UserCoordinateSystems.Add(origin, xAxisPnt, yAxisPnt, "NewUcs1")
acadAPP.ActiveDocument.ActiveUCS = ucsOBJ |
|
置顶卡
