（完成）[编程申请]：坐标和高程

3602705

能否来个演示，标注值不在标注点旁边，离得好远

myfreemind

试试下面这个坐标注记程序，没有加高程功能，你自己加吧，很简单的！

Sub zzb()
On Error GoTo ERR
Dim ver(0 To 5) As Double '多段线顶点坐标
Dim plineobj As AcadLWPolyline '多段线
Dim text_x As AcadText 'X坐标
Dim text_y As AcadText 'Y坐标
Dim xins(0 To 2) As Double 'X坐标插入点
Dim yins(0 To 2) As Double 'Y坐标插入点
Dim zjlayer As AcadLayer '注记层
Dim ltxt As Single '坐标文本长度
Dim lint As Integer '坐标文本长度
Dim us1 As String '比例尺
Dim us2 As String '左下角X坐标
Dim us3 As String ''左下角Y坐标


Set zjlayer = ThisDrawing.Layers.Add("ZJ_NEW")


zjlayer.Color = acCyan

Dim x As String
Dim y As String

Dim p1 As Variant
Dim p2 As Variant
Dim p3(0 To 1) As Double
'  ThisDrawing.SetVariable "OSMODE", 1
p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "选择注记点:")


p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "注记坐标 ")



ltxt = 17


If p2(0) > p1(0) And p2(1) > p1(1) Then
GoTo 1 '第一象限
ElseIf p2(0) > p1(0) And p2(1) < p1(1) Then
GoTo 1 '第二象限
ElseIf p2(0) < p1(0) And p2(1) < p1(1) Then
GoTo 2 '第三象限
ElseIf p2(0) < p1(0) And p2(1) > p1(1) Then
GoTo 2 '第四象限
End If

1:
p3(0) = p2(0) + ltxt
p3(1) = p2(1)
xins(0) = p2(0) + 1
xins(1) = p2(1) + 1
yins(2) = 0
yins(0) = p2(0) + 1
yins(1) = p2(1) - 3
yins(2) = 0
GoTo zj

2:

p3(0) = p2(0) - ltxt
p3(1) = p2(1)
xins(0) = p3(0) + 1
xins(1) = p3(1) + 1
yins(2) = 0
yins(0) = p3(0) + 1
yins(1) = p3(1) - 3
yins(2) = 0

zj:
ver(0) = p1(0)
ver(1) = p1(1)
ver(2) = p2(0)
ver(3) = p2(1)
ver(4) = p3(0)
ver(5) = p3(1)





p1(0) = p1(0): p1(1) = p1(1)

x = Format(p1(0), "####0.000")
y = Format(p1(1), "####0.000")

Set plineobj = ThisDrawing.ModelSpace.AddLightWeightPolyline(ver) '二维轻量多段线
plineobj.Layer = "ZJ_NEW"


Set text_x = ThisDrawing.ModelSpace.AddText(" X" & " " & x, xins, 2)
Set text_y = ThisDrawing.ModelSpace.AddText("NY" & " " & y, yins, 2)
text_x.Layer = "ZJ_NEW"
text_y.Layer = "ZJ_NEW"


Exit Sub

ERR:
Resume
End Sub

围棋

多谢，很方便，这下好多了。

macheng1979

我也想要在R14能用的

chenhang1203

最初由 eachy 发布
[B]请试用，过滤选择标注用 (SSget '((-3 ("Yb_zbbz")))) [/B]

能否公开源码？

zhletian

还是晓东CAD资料全，找了好久，才在这里找到。以后要多来点，收获很大。

th_fang2004

我也想试一试，不知道能否自动标注，会不会比天正的好用．

lhjlyy0

不看不知道，一看吓我一跳，我整天对着电脑用，却不知道有这麽多的开发，以后好好学。多谢

hsb-hy

如果能够自动读起地形图上的高程就好了！

qiuxiaping

命令写得太长了，建议改成只要输“zb”就好了。

chen78

最初由 eachy 发布
[B]请试用，过滤选择标注用 (SSget '((-3 ("Yb_zbbz")))) [/B]

我下了，用了很好，但不知eachy 怎么不解决问题，楼上说了：1.命令太长2.解决用于R14

齐小社88

都是好东西，坐标的标注我下了好几个，都不错，这个也试以下，谢谢提供。

lhb5175

太感谢了，我也正在需要用呢

89345330

能说2句吗？

dearjdz123

我怎么还是下不下来啊？？斑竹先生，在此请教。