求能提取坐标并能在CAD上生成坐标表的小程序

hfjhfj

求能提取坐标并能在CAD上生成坐标表的小程序

夜战双乔

测试了，很强大，感谢原作者，感谢分享者

sy100

下面这个是网上收集的，很好用，看看是否能满足你的需要。在此感谢原作者！

--------------------------------------

 ;;;功能：测量并写坐标(表格方式) (输出XYZ)
;;;日期：zml84 于 2007-04-07              
;;;========================================
(defun c:zbbg ()

    ;;命令回显
    (setvar "CMDECHO" 0)
    (command "undo" "be")
    ;;捕捉设置  
    (setq osmode_old (getvar "OSMODE"))

    ;;参数设置
    (if (= 内框颜色 nil)
 (setq 内框颜色 1
       文字颜色 2
       外框颜色 3
       坐标精度 3
       表格_高度 6
       表格_宽度1
   16
       表格_宽度2
   10
       表格_宽度3
   25
       表头字高 2.5
       表中字高 2.0
 )
    )

    ;;绘制表头
    (initget "G g")
    (setq pt0 (getpoint "\n请指定表格绘制位置，或者 [改变参数(G)]:"))

    (if (or (= pt0 "G") (= pt0 "g"))
 (progn
     (sz)

     (setq pt0 (getpoint "\n请指定表格绘制位置:"))
 )
    )
    (setq pt0_x (car pt0)
   pt0_y (cadr pt0)
    )
    (SETQ PT1 (polar PT0 0 表格_宽度1)
   PT3 (polar PT1 0 表格_宽度2)
   PT5 (polar PT3 0 表格_宽度3)
   PT7 (polar PT5 0 表格_宽度3)
   PT701 (polar PT7 0 表格_宽度3)
   PT2 (polar PT1 (* -0.5 PI) 表格_高度)
   PT4 (polar PT3 (* -0.5 PI) 表格_高度)
   PT6 (polar PT5 (* -0.5 PI) 表格_高度)
   PT8 (polar PT7 (* -0.5 PI) 表格_高度)
   PT801 (polar PT701 (* -0.5 PI) 表格_高度)
   PT9 (polar PT0 (* -0.5 PI) 表格_高度)
    )
    (COMMAND "color" 内框颜色)
    (COMMAND "PLINE" PT0 PT701 PT801 PT9 PT0 "")
    (COMMAND "PLINE" PT1 PT2 PT4 PT3 PT4 PT6 PT5 PT6 PT8 PT7 pt8 pt801
      pt701 "")
    (SETQ ZBS1 (entlast))

    (SETQ PT10 (polar PT0 (* -0.5 PI) (/ 表格_高度 2.0))
   PT10 (polar PT10 0 (/ 表格_宽度1 2.0))
    )
    (SETQ PT11 (polar PT10 0 (/ (+ 表格_宽度1 表格_宽度2) 2.0))
   PT12 (polar PT11 0 (/ (+ 表格_宽度2 表格_宽度3) 2.0))
   PT13 (polar PT12 0 表格_宽度3)
   PT14 (polar PT13 0 表格_宽度3)
    )
    (COMMAND "color" 文字颜色)
    (COMMAND "TEXT" "J" "MC" PT10 表头字高 0.0 "编  号")
    (COMMAND "TEXT" "J" "MC" PT11 表头字高 0.0 "点号")
    (COMMAND "TEXT" "J" "MC" PT12 表头字高 0.0 "坐 标（X）")
    (COMMAND "TEXT" "J" "MC" PT13 表头字高 0.0 "坐 标（Y）")
    (COMMAND "TEXT" "J" "MC" PT14 表头字高 0.0 "坐 标（Z）")

    ;;表头绘制完毕
    ;;下面点取待测点
    (SETQ I 1)
    (setvar "OSMODE" osmode_old)
    (WHILE (/= nil
        (SETQ PTI
   (GETPOINT (strcat "\n请指定要测量位置<第" (itoa i) "次>:")
   )
        )
    )
 (setq osmode_old (getvar "OSMODE")) ;设置捕捉模式
 (setvar "OSMODE" 0)
 (COMMAND "COPY" ZBS1 "" pt0 pt9)
 (SETQ ZBS1  (entlast)
       pt11  (polar PT11 (* -0.5 PI) 表格_高度)
       pt12  (polar PT12 (* -0.5 PI) 表格_高度)
       pt13  (polar PT13 (* -0.5 PI) 表格_高度)
       pt14  (polar PT14 (* -0.5 PI) 表格_高度)
       pti_x (rtos (car PTI) 2 坐标精度)
       pti_y (rtos (cadr PTI) 2 坐标精度)
       pti_z (rtos (caddr PTI) 2 坐标精度)
 )
 (princ (strcat "X=" pti_y "  Y=" pti_x "  Z=" pti_z))

 (COMMAND "TEXT"
   "J"
   "MC"
   PT11
   表中字高
   0.0
   (strcat (itoa i) "#")
 )
 (COMMAND "TEXT" "J" "MC" PT12 表中字高 0.0 pti_x)
 (COMMAND "TEXT" "J" "MC" PT13 表中字高 0.0 pti_y)
 (COMMAND "TEXT" "J" "MC" PT14 表中字高 0.0 pti_z)

 (setq i (+ i 1))
 (setvar "OSMODE" osmode_old)
    )

    ;;如果记录有坐标数据，就绘制外边框
    (if (> i 1)
 (progn

     (setq osmode_old (getvar "OSMODE")) ;设置捕捉模式
     (setvar "OSMODE" 0)
     ;;绘制外框
     (SETQ PT701 (polar PT701 (* -0.5 PI) (* 表格_高度 I)))
     (COMMAND "color" 外框颜色)
     (COMMAND "rectang" "W" 0.2 PT0 PT701)
     ;;编号信息
     (setq xxx nil
    xxx (getstring T "\n请输入编号信息: ")
     )
     (if (= xxx "")
  (setq xxx "请写编号信息")
     )
     (setq pt9 (polar PT9 (* -0.5 PI) (* 表格_高度 (- I 1) 0.5))
    pt9 (polar PT9 0 (/ 表格_宽度1 2.0))
     )
     (COMMAND "TEXT" "J" "MC" PT9 表中字高 0.0 xxx)

     (princ (strcat "\n操作已完成，共收集到"
      (itoa (- i 1))
      "个坐标点。"
     )
     )
 )
 (princ "\n操作已完成，没有收集到坐标点！！")
    )

    ;;退出处理
    (command "undo" "e")
    (if (= i 1)
 (command "undo" 1)
    )
    (setvar "OSMODE" osmode_old)
    (setvar "CMDECHO" 1)
    (princ)
)

;;;===================================================
(defun c:sz ()
    (sz)
    (princ
 "\n键入命令\"SZ\"可进行坐标测量绘制时用到的参数设置。"
    )
    (princ)
)
;;;===================================================
;;;设置　　参数
(defun sz ()
    (princ "\n设置坐标标注中的参数,请输入选项:")

    (princ (strcat "\n[第1列宽度(1)"     "/第2列表格宽度(2)"
     "/第3列表格宽度(3)"     "/表格高度(4)/"
     "\n表头字高(5)"     "/表中字高(6)"
     "/恢复默认值(0)]"
    )
    )

    (setq ii (getint "\n请输入选项:")
    )

    (if (or (= ii nil) (< ii 0) (> ii 6))
 (princ "\n参数无改变，设置完成!")
 (cond
     ((= ii 0)
      (progn
   (setq 内框颜色 1
         文字颜色 2
         外框颜色 3
         坐标精度 3
   )
   (setq 表格_高度 6
         表格_宽度1
     16
         表格_宽度2
     10
         表格_宽度3
     25
         表头字高 2.5
         表中字高 2.0
   )
   (princ "\n参数已全部恢复至默认值。")
      )
     )

     ((= ii 1)
      (progn (princ (strcat "\n请输入第1列宽度<当前值"
       (rtos 表格_宽度1 2 坐标精度)
       ">:"
      )
      )
      (setq 表格_宽度1_x (getdist))
      (if (= 表格_宽度1_x nil)
   (princ "第1列宽度无改变!")
   (= 表格_宽度1 表格_宽度1_x)
      )
      )
     )
     ((= ii 2)
      (progn (princ (strcat "\n请输入第2列宽度<当前值"
       (rtos 表格_宽度2 2 坐标精度)
       ">:"
      )
      )
      (setq 表格_宽度2_x (getdist))
      (if (= 表格_宽度2_x nil)
   (princ "第1列宽度无改变!")
   (= 表格_宽度2 表格_宽度2_x)
      )
      )
     )
     ((= ii 3)
      (progn (princ (strcat "\n请输入第3~5列宽度<当前值"
       (rtos 表格_宽度3 2 坐标精度)
       ">:"
      )
      )
      (setq 表格_宽度3_x (getdist))
      (if (= 表格_宽度3_x nil)
   (princ "第3列宽度无改变!")
   (= 表格_宽度3 表格_宽度3_x)
      )
      )
     )

     ((= ii 4)
      (progn (princ (strcat "\n请输入表格高度<当前值"
       (rtos 表格_高度 2 坐标精度)
       ">:"
      )
      )
      (setq 表格_高度_x (getdist))
      (if (= 表格_高度_x nil)
   (princ "表格高度无改变!")
   (= 表格_高度 表格_高度_x)
      )
      )
     )

     ((= ii 5)
      (progn (princ (strcat "\n请输入表头字高<当前值"
       (rtos 表头字高 2 坐标精度)
       ">:"
      )
      )
      (setq 表头字高_x (getdist))
      (if (= 表头字高_x nil)
   (princ "表头字高无改变!")
   (= 表头字高 表头字高_x)
      )
      )
     )

     ((= ii 6)
      (progn (princ (strcat "\n请输入表中字高<当前值"
       (rtos 表中字高 2 坐标精度)
       ">:"
      )
      )
      (setq 表中字高_x (getdist))
      (if (= 表中字高_x nil)
   (princ "表中字高无改变!")
   (= 表中字高 表中字高_x)
      )
      )
     )
     (t nil)
 )
    )
    (princ)
)

;;;==================================================

;;以下为加载时提示信息
(princ "\n键入命令\"SZ\"可进行参数设置。")
(princ "\n键入命令\"ZB\"可进行坐标测量绘制(表格方式)。")
(princ)

hfjhfj

谢谢sy100兄弟，挺好用的，就是表格不是很进人意，要是有竖线就好的。

hfjhfj

但是不能改变表格大小呀

zctao1966

虽然没有用过，我还是支持一下。。。

tim0532

太深奥了，看不懂

chyzy505

简单 2009-1-9 20:19:54
;;;功能：测量并写坐标(表格方式) (输出XYZ)
;;;日期：zml84 于 2007-04-07           

网上到处你的资料

呵呵
ZML84 2009-1-9 20:21:09
？
ZML84 2009-1-9 20:21:48
呵呵，只要不盗用，不用做商业用途。
ZML84 2009-1-9 20:21:49
即可。

是 ZML84 写的程序

不错的资料

xuyujason

不能修改点坐标的精度吗？

gongli08

看不懂