点坐标导出程序！

myfreemind

Dim outtxt As String
Private Sub CommandButton1_Click()



CommonDialog1.Filter = "TXT文件|*.txt|DAT文件|*.dat"
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1


Print #1, outtxt
Close #1
MsgBox " 文件" & CommonDialog1.FileName & "创建成功!"
Unload Me
End Sub

Private Sub CommandButton2_Click()

Dim pnt As AcadPoint

Dim dnr As String
Dim entity As AcadEntity
Dim ft(0) As Integer
Dim fd(0) As Variant
Dim us1 As Integer '图形比例尺
Dim us2 As Integer '左下角X坐标
Dim us3 As Integer '左下角Y坐标
us1 = ThisDrawing.GetVariable("userr1")
us2 = ThisDrawing.GetVariable("userr2")
us3 = ThisDrawing.GetVariable("userr3")
'Dim pnt_cord(0 To 1) As Double
Dim sset As AcadSelectionSet
Dim i As Integer

For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next
ft(0) = 0
fd(0) = "oint"
Set sset = ThisDrawing.SelectionSets.Add("Sset_P")
sset.Select acSelectionSetAll, , , ft, fd
ReDim pnt_cord(sset.Count - 1) As Variant
ReDim x(sset.Count - 1)
ReDim y(sset.Count - 1)
dnr = ""

For i = 0 To sset.Count - 1
pnt_cord(i) = sset.Item(i).Coordinates

Select Case us1
Case 500
If us2 = 0 And us3 = 0 Then
x(i) = (pnt_cord(i)(1) - 100) / 2
y(i) = (pnt_cord(i)(0) - 100) / 2
ElseIf us2 = 100 And us3 = 100 Then
x(i) = (pnt_cord(i)(1) + 100) / 2
y(i) = (pnt_cord(i)(0) + 100) / 2
End If
Case 1000
If us2 = 0 And us3 = 0 Then
x(i) = pnt_cord(i)(1) - 100
y(i) = pnt_cord(i)(0) - 100
ElseIf us2 = 100 And us3 = 100 Then
x(i) = pnt_cord(i)(1)
y(i) = pnt_cord(i)(0)
End If

End Select


'*******按scs2000展点文件格式排列点
dnr = dnr & vbCrLf & (i + 1) & vbCrLf & "" & vbCrLf & y(i) & vbCrLf & x(i) & vbCrLf & pnt_cord(i)(2)

Next
outtxt = sset.Count & dnr
MsgBox "点导出成功，请保存文件!"
End Sub

czswri

我在绘一些图时，常要将交点坐标导入电子表格，只能把坐标点记下，再填到表格，非常烦人，工作量大。看了楼上的程序可能很适用，可我看不懂。(但我也复制了一份)
是否可劳大驾，把每句的意思说一下，我好照葫芦画瓢？

myfreemind

我上面的这个程序是将屏幕点坐标导出，并生成一个格式的文本文件以供我所用的CAD展点！对你需要将交点坐标填入表格可能作用不大，你干脆用我另外一个程序，多重粘贴程序，在http://beercz.yeah.net下载，可以一次行复制多个坐标文本，然后粘贴到电子表格中，我经常是这样复制坐标的，非常好用！

HQ_2003

你主页上的程序“线段多重偏移程序(offset命令的扩展，针对地籍测量工作)“和“角度查询程序(针对acad2000,scs2000)“下载后用cad无法加载

myfreemind

无法加载？错误提示是怎样的？

HQ_2003

加载文件后当点击“启用宏“按钮时提示“文件未找到，点击确定后提示“无法从文件加载工程“

myfreemind

那就奇怪，我这里运行一切正常！

lixiaochun

我的工作中也经常需要知道一些点的相对坐标。我的做法是先定义坐标的原点，然后用list命令依次选取每个点，将屏幕上的文本复制到记事本中，留下坐标数值，删除其余的文字后导入excel。非常麻烦。希望能用上你的程序。但本人的水平太差，根本不知道如何在cad中使用上面的程序，望详细指教。不知道为什么，你的主页也连接不上。

myfreemind

我上面的那个程序是针对我工作用的软件而写的，你直接用可以会无法执行，等我改改再帖上来给你！

无法登陆网页可能是网络的问题，我有时也上不去！

bzjustb

两图元交点导入表格的程序搞定了吗？我想参考一下，谢谢您拉！