[编程申请]：求：点坐标自动标注的程序

雨中漫步0423

坐规划的定点用，想到一种自动标注交点坐标的程序，还有单个点坐标标注的程序，CAD自带的那个好像只能做X或Y方向的标注，不能两个一起标注……

想标注成这样

liuqian0204

程序不超20行就可解决,但这个程序不是我的原创,恕不能奉告。
请问你是哪个单位的?

自由的鱼

[php]
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
[/php]

雨中漫步0423

liuqian0204  |……无可奉告就都不要告诉我啊……说有却不告诉我……如果没有小鱼儿，我是会很可怜的……我是建筑设计院的
小鱼儿，呵呵谢谢了……

自由的鱼

搞定了，已经寄到你的信箱，看看好不好用！
这是我最后一次写LISP程序了，都荒废了，调试好难啊，呵呵

雨中漫步0423

自由……
LISP文件大家都能用啦，比那个VBA好，为什么你都喜欢用VBA呢？
而且MNC什么的好像也很好用……因为我会用，呵呵，可是你都不做……

自由的鱼

因为我不是专业的CAD开发人员啊，所以学不会LISP，平时主要用的是VB，而且做的程序也和CAD不太相关，VBA作为VB的一个子类，我当然就很熟悉了，如果你装了2002，什么程序我都可以搞定~~：）

雨中漫步0423

这样啊……那我有空就改装2002，然后要用的程序我都找你搞定就好了  ：）

VBA都是干什么用的啊？

自由的鱼

VBA是VB的一个分支，AUTOCAD支持许多语言来进行二次开发，LISP，VBA。。。等等

要用的程序都找我？只要我可以做出来，建筑我可不懂！呵呵

liuqian0204

多动脑筋

雨中漫步0423

自由……你放心……建筑你不懂，我也会让你明白我想要的，然后要你做的……呵呵

自由的鱼

下次做程序你要付电钱，咖啡钱，眼药水钱。。。。。等等。呵呵

雨中漫步0423

不是吧？自由……电钱？咖啡？还有眼药水？就我所知道，就算你不做程序，电脑也是长时间开着，要我付电钱……是不是太黑了点了？
而且你平时也不会很早睡，根本不就用喝咖啡，至于眼药水……你要的话，我寄给你好了

自由的鱼

呵呵，是谁泄密啊

HLSDJ

ZDM2000中有坐标标柱和自动成表。