明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 6038|回复: 8

修改后的坐标注记程序!现在不会导致"死机了"!

  [复制链接]
发表于 2003-7-23 21:27 | 显示全部楼层 |阅读模式
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

评分

参与人数 1威望 +1 金钱 +10 贡献 +5 激情 +5 收起 理由
mccad + 1 + 10 + 5 + 5 【好评】好程序

查看全部评分

发表于 2004-1-15 19:36 | 显示全部楼层
好程序啊!怎么跑到后面来了!
顶!
发表于 2004-1-18 21:54 | 显示全部楼层
能否批量标注块的坐标?
 楼主| 发表于 2004-1-18 22:02 | 显示全部楼层
程序改一下应该可以的,你修改一下!
发表于 2004-8-27 09:40 | 显示全部楼层
好东西。。。顶。。。可是请问楼主。。程序该放在那个文件内啊????我的时ACAD2002+天正6
发表于 2006-5-1 20:34 | 显示全部楼层
先顶一下
发表于 2006-5-6 18:35 | 显示全部楼层

先顶一下再说

 

发表于 2006-5-18 01:13 | 显示全部楼层
不知道怎么用,支持一下:)
发表于 2006-11-10 10:54 | 显示全部楼层
函数错误:0
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 18:52 , Processed in 0.187215 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表