[求助]如何一次提取所有选取的圆的圆心坐标?

neda321

如何一次提取所有选取的圆的圆心坐标?

电子图上有1300根桩，如何一次提取他们圆心的坐标值啊，谢谢。在线等，qq：49995529

BDYCAD

就是取出所有圆的DXF组码的10, 就是圆心坐标喽.

刚写一个请参考:

;;;时间2007-05-07
;;;编程:BDYCAD
(defun c:test(/ CENTERPOINT DXF ENAME I SS SSL)
  (princ"\n请选择要取圆心坐标的圆：")
  (setq ss(ssget))
  (if ss
    (progn
      (setq i 0 ssl (sslength ss))
      (repeat ssl
 (setq ename(ssname ss i))
 (setq dxf(entget ename))
 (setq CenterPoint(cdr(assoc 10 dxf)))
 (princ(strcat"\n第 "(rtos i)" 个圆的坐标点是："))
 (princ CenterPoint)
 (setq i(1+ i))
 )
      )
    (princ"\n没有选到圆圈，请再试一次.")
    )
  (princ)
  )

zml84

2楼是LISP代码，下面这是采用VBA的方式。请对比。

3. Sub ctoe()
4. Dim rownum As Integer
5. Dim Found As Boolean
6. Dim MyObject As AcadEntity
8. rownum = 2
9. Found = False
10. For Each MyObject In ThisDrawing.ModelSpace               '在模型空间中遍历所有的图元
11.         If StrComp(MyObject.EntityName, "acdbcircle", 1) = 0 Then '这一句是判断对象是否是圆
12.                
13.                 If rownum = 2 Then '若是圆对象
14.                         Dim Excel As Excel.Application
15.                         Dim ExcelWorkbook As Object
16.                         Dim ExcelSheet As Object
17.                         Set Excel = New Excel.Application '启动EXCEL
18.                         Set ExcelWorkbook = Excel.Workbooks.Add
19.                         Set ExcelSheet = Excel.ActiveSheet
20.                         'Excel.Visible = True   '显示EXCEL
21.                         Dim pt '(0 To 2)   '定义数组变量，存储圆心坐标
22.                 End If
23.                
24.                 pt = MyObject.Center
25.                 ExcelSheet.Cells(rownum, 1) = "编号待定"
26.                 ExcelSheet.Cells(rownum, 2) = pt(0)                '圆心坐标X值
27.                 ExcelSheet.Cells(rownum, 3) = pt(1)                '圆心坐标Y值
28.                 ExcelSheet.Cells(rownum, 4) = pt(2)                '圆心坐标Z值
29.                 rownum = rownum + 1
30.                 Found = True '将标记设成 True。
31.         End If '结束IF
32. Next MyObject '遍历下一个对象
34. If Found = True Then
35.         ExcelSheet.Cells(1, 1) = "编号"
36.         ExcelSheet.Cells(1, 2) = "X"
37.         ExcelSheet.Cells(1, 3) = "Y"
38.         ExcelSheet.Cells(1, 4) = "Z"
39.         MsgBox "圆心坐标输出完毕，请检阅！"
40.         Excel.Visible = True   '显示EXCEL
41.         Set ExcelSheet = Nothing
42.         Set ExcelWorkbook = Nothing
43.         Set Excel = Nothing
44. Else
45.         MsgBox "在当前模型空间中未找到圆对象！"
46. End If
48. End Sub

Sub ctoe() Dim rownum As Integer Dim Found As Boolean Dim MyObject As AcadEntity rownum = 2 Found = False For Each MyObject In ThisDrawing.ModelSpace               '在模型空间中遍历所有的图元         If StrComp(MyObject.EntityName, "acdbcircle", 1) = 0 Then '这一句是判断对象是否是圆                                 If rownum = 2 Then '若是圆对象                         Dim Excel As Excel.Application                         Dim ExcelWorkbook As Object                         Dim ExcelSheet As Object                         Set Excel = New Excel.Application '启动EXCEL                         Set ExcelWorkbook = Excel.Workbooks.Add                         Set ExcelSheet = Excel.ActiveSheet                         'Excel.Visible = True   '显示EXCEL                         Dim pt '(0 To 2)   '定义数组变量，存储圆心坐标                 End If                                 pt = MyObject.Center                 ExcelSheet.Cells(rownum, 1) = "编号待定"                 ExcelSheet.Cells(rownum, 2) = pt(0)                '圆心坐标X值                 ExcelSheet.Cells(rownum, 3) = pt(1)                '圆心坐标Y值                 ExcelSheet.Cells(rownum, 4) = pt(2)                '圆心坐标Z值                 rownum = rownum + 1                 Found = True '将标记设成 True。         End If '结束IF Next MyObject '遍历下一个对象 If Found = True Then         ExcelSheet.Cells(1, 1) = "编号"         ExcelSheet.Cells(1, 2) = "X"         ExcelSheet.Cells(1, 3) = "Y"         ExcelSheet.Cells(1, 4) = "Z"         MsgBox "圆心坐标输出完毕，请检阅！"         Excel.Visible = True   '显示EXCEL         Set ExcelSheet = Nothing         Set ExcelWorkbook = Nothing         Set Excel = Nothing Else         MsgBox "在当前模型空间中未找到圆对象！" End If End Sub

更多讨论见：
http://p4.xdcad.net/forum/showthread.php?s=&postid=3113742#post3113742
思路在3楼，代码在5楼。

kmjlsp

如何把圆心坐标中的括号去除,"把第*个圆的坐标点是："改为只显示序号,还有能把这些点存成TXT文件就更好了.

lyt0623

楼主是学测量的吧,我也常要解决此类问题,不过为每个圆心编上编号,再用程序向EXCEL输出坐标文件不是更好.输出程序见下

(defun c:lytzbsc()
;;; 在图中向文件E:\\123\\2.xls输出选中字体角点坐标程序
  (VL-LOAD-COM)
  (setq AcadObject(vlax-get-acad-object)
        AcadDocument(vla-get-ActiveDocument AcadObject)
        mSpace(vla-get-ModelSpace AcadDocument)
  )
  (setq fp1(open "E:\\123\\2.xls" "w"))
  (setq p1(getpoint "\n请输入第一点:"))
  (setq p2(getpoint "\n请输入第二点:"))
  (setq ss(ssget "W" P1 p2))
  (SETQ t1 "text=")
  (setq a1 0)
  (setq tt1(cdr(assoc 1 (entget(ssname ss a1)))))
  (setq d1(cdr(assoc 10 (entget(ssname ss a1)))))
  (princ "\t" fp1)  (princ tt1 fp1)
  (princ "\t" fp1)  (princ "x=" fp1) 
    (princ "\t" fp1)  (princ (cadr d1) fp1)
   (princ "\t" fp1)  (princ "y=" fp1)
  (princ "\t" fp1)  (princ (car d1) fp1)
  (while  (ssname ss (+ a1 1))
    (setq a1 (+ a1 1))
    (setq tt1 (cdr (assoc 1 (entget(ssname ss a1)))))
     (setq d1 (cdr (assoc 10 (entget(ssname ss a1)))))
    (print t1 fp1)
      (princ "\t" fp1)  (princ tt1 fp1)
  (princ "\t" fp1)  (princ "x=" fp1)
       (princ "\t" fp1)  (princ (cadr d1) fp1)
   (princ "\t" fp1)  (princ "y=" fp1)
  (princ "\t" fp1)  (princ (car d1) fp1)
    )
  (close fp1)
 
 )

TLHMQH

二楼的程序若坐标值超过7位数时，输出的是科学记数法。

如：第 1.0000 个圆的坐标点是：(208948.0 1.59701e+006 0.0)。

能否修改完善。

xgr

如果楼主是搞测量的话，我想给几点建议：

 1 你所说的1300根桩，如果要加桩号的话，最好是放在扩展数据里，以后注记、删除、查找桩号很方便，只要读出扩展数据就可以了；

 2 编程取坐标可用多段线圈选的方法，这样更灵活；

 3 生成的坐标数据用文本格式更方便交流，比如说要传入全站仪就很方便了。

  以上建议仅供你的参考。

Andyhon

1. 若坐标值超过7位数时，输出的是科学记数法 ....

复制代码

;(princ CenterPoint)
==>
(setq  prec 8 )            ; 精度可以到 (共16位)
(princ (rtos (car CenterPoint) 2 prec))    ; x
(princ " ")
(princ (rtos (cadr CenterPoint) 2 prec))   ; y
(princ " ")
(princ (rtos (caddr CenterPoint) 2 prec))  ; z