明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2839|回复: 5

广东省地质测绘院院长李冰峰程序-打点检查平面

[复制链接]
发表于 2015-9-6 15:26 | 显示全部楼层 |阅读模式
  1. ;;打点检查之输出点位坐标
  2. (defun c:zdhsc(/ zdh_ss fileneme zdhn len f pp x y xystr)
  3. (setq zdh_ss (ssget "X" (list (cons 0 "point") (cons 8 "zdh"))))
  4. (if zdh_ss (progn
  5. (setq filename (getfiled "输入要保存的数据文件名<.txt>:" "d:/" "txt" 5))
  6. (if filename (progn
  7. (setq zdhn 0 len (sslength zdh_ss))
  8. (setq f (open filename "w"))
  9. (while (< zdhn len)
  10. (setq pp (cdr (assoc '10 (entget (ssname zdh_ss zdhn)))))
  11. (setq x (rtos (cadr pp) 2 3) y (rtos (car pp) 2 3))
  12. (setq zdhn (+ zdhn 1))
  13. (setq xystr (strcat (itoa zdhn) " " x " " y))
  14. (write-line xystr f)
  15. );while
  16. (setq zdh_ss nil)
  17. (close f)
  18. (princ (strcat "\n共输出" (itoa len) "个点的坐标成果,成果文件为:" filename))
  19. );progn
  20. (princ "\n未设置文件名,未进行坐标输出操作。")
  21. );if
  22. );progn
  23. (princ "\n图形中没有任何点位!")
  24. );if
  25. (princ)
  26. );defun
  27. ;;---------------------------------------------------------------------------------
  28. (DEFUN sh_ch ( LST /  )
  29. (COMMAND "_.ZOOM" "C" LST "1")
  30.   )
  31. ;;打点检查之形成坐标分析文件
  32. (defun c:ddjc()
  33. (setq filename (getfiled "选择检查点的坐标数据文件名<.txt>:" "" "txt" 0))
  34. (if filename (progn
  35. (setq ddlist nil endk 0 nddlist nil)
  36. (setq f (open filename "r"))
  37. (while (setq ddstr (read-line f))
  38. (setq ddstr (strcat "(" ddstr ")"))
  39. (if (= ddlist nil)
  40. (setq ddlist (list (reverse (read ddstr))))
  41. (setq ddlist (cons (reverse (read ddstr)) ddlist))
  42. );if
  43. );while
  44. (close f)
  45. (if ddlist (progn
  46. (setq ddlist (reverse ddlist) ddnn 0 len (length ddlist))
  47. (if (= ddn nil) (setq ddn 0))
  48. (while (= ddnn 0)
  49. (setq ddnn (getint (strcat "\n共" (itoa len) "个点,请选择从第几个点开始<" (itoa (+ ddn 1)) ">:")))
  50. (if (= ddnn nil) (setq ddnn (+ ddn 1)))
  51. (if (and (> ddnn 0) (< ddnn (+ len 1))) (setq ddn (- ddnn 1)) (setq ddnn 0))
  52. );while
  53. (while (and (< ddn len) (/= endk 1))
  54. (setq po_all (list (reverse (cdr (reverse (nth ddn ddlist))))))
  55. (sh_ch (CAR po_all))
  56. (initget "U S B")
  57. (princ (strcat "\n共" (itoa len) "个点,现在是第" (itoa (+ ddn 1)) "个点。"))
  58. (setq pp (getpoint "\n回到上一点(U)/跳过此点(S)/作标记并跳过此点(B)<采集原坐标点或空回车结束>:"))
  59. (cond (( = pp "U")
  60.        (if (/= (+ ddn 1) ddnn) (progn
  61.        (setq ddn (- ddn 1))
  62.        (if (and nddlist (= (nth 0 (nth 0 nddlist)) (nth 2 (nth ddn ddlist))))
  63.        (setq nddlist (cdr nddlist))
  64.        );if
  65.        );progn
  66.        (princ "\已不能回退!")
  67.        );if
  68.       )
  69.       ((= pp "S")
  70.        (setq ddn (+ ddn 1))
  71.       )
  72.       ((= pp "B")
  73.        (setq p0 (reverse (cdr (reverse (nth ddn ddlist)))))
  74.        (entmake (list (cons 0 "CIRCLE") (cons 8 "标记") (cons 62 1) (cons 10 p0) (cons 40 0.5)))
  75.        (setq ddn (+ ddn 1))
  76.       )
  77.       ((= pp nil)
  78.        (initget "Y N")
  79.        (setq ddkey (getkword "\n是否是否要结束取点?是(Y)/否(N)<N>:"))
  80.        (if (= ddkey "Y") (setq endk 1))
  81.       )
  82.       ((= (type pp) (type (list 1 1)))
  83.        (entmake (list (cons 0 "CIRCLE") (cons 8 "0") (cons 62 3) (cons 10 pp) (cons 40 0.05)))
  84.        (initget "Y N")
  85.        (setq ddkey (getkword "\n是否为小绿色标记圆的点,是(Y)/否(N)<Y>:"))
  86.        (command "erase" (entlast) "")
  87.        (if (or (= ddkey nil) (= ddkey "Y")) (progn
  88.        (setq pp (cons (nth 2 (nth ddn ddlist)) pp))
  89.        (if nddlist (setq nddlist (cons pp nddlist)) (setq nddlist (list pp)))
  90.        (setq ddn (+ ddn 1))
  91.        ));if
  92.       )
  93. );cond
  94. );while
  95. (if nddlist (progn
  96. (princ (strcat "\n共采集到" (itoa (length nddlist)) "个原坐标点。"))
  97. (setq filename nil nddlist (reverse nddlist))
  98. (initget "X A W")
  99. (setq ddkey (getkword "\n不保存数据退出(X)/追加保存数据(A)/覆盖保存数据(W)<W>:"))
  100. (if (= ddkey nil) (setq ddkey "W"))
  101. (if (= ddkey "W")
  102. (setq filename (getfiled "选择数据文件名<.txt>:" "" "txt" 5))
  103. );if
  104. (if (= ddkey "A")
  105. (setq filename (getfiled "选择数据文件名<.txt>:" "" "txt" 0))
  106. );if
  107. (if filename (progn
  108. (setq zn 0 ddnn 0)
  109. (if (= ddkey "A") (progn
  110. (setq f (open filename "r"))
  111. (while (setq ddstr (read-line f))
  112. (setq zn (+ zn 1))
  113. );while
  114. (close f)
  115. );progn
  116. );if
  117. (setq f (open filename ddkey))
  118. (while (and (/= ddkey "X") (< ddnn (length nddlist)))
  119. (setq pp (nth ddnn nddlist))
  120. (setq n (nth 0 pp))
  121. (setq pp1 (nth (- n 1) ddlist))
  122. (setq ddstr (strcat (itoa (+ ddnn 1 zn)) " " (rtos (nth 1 pp1) 2 3) " " (rtos (nth 0 pp1) 2 3) " " (rtos (nth 2 pp) 2 3) " " (rtos (nth 1 pp) 2 3)))
  123. (write-line ddstr f)
  124. (setq ddnn (+ ddnn 1))
  125. );while
  126. (close f)
  127. (princ (strcat "\n数据已保存在" filename ",文件中共有" (itoa (+ ddnn zn)) "个点的坐标检查数据。"))
  128. );progn
  129. (if (and (/= ddkey "X") (= filename nil)) (princ "\n未选择文件名,数据未保存!") (princ "\n程序已退出,数据未保存!"))
  130. );if
  131. );progn
  132. (princ "\n没有采集到原坐标点!")
  133. );if
  134. );progn
  135. (princ (strcat "\n" filename "中没有坐标数据!"))
  136. );if
  137. );progn
  138. (princ "\n未设置检查点的坐标数据文件,未进行任何操作。")
  139. );if
  140. (princ)
  141. );defun
发表于 2015-9-6 22:30 | 显示全部楼层
能讲解一下功能吗?有点每太看懂,最好是配个演示
发表于 2015-9-12 00:52 | 显示全部楼层
本帖最后由 scwdb809 于 2015-9-15 14:02 编辑

10多年前的老程序了,发帖人应尊重原代码编写人的劳动成果!
发表于 2015-10-2 09:28 | 显示全部楼层
没有演示,不知道是干嘛用的![em0]
发表于 2016-3-28 11:34 | 显示全部楼层
南方Cass有这个功能
发表于 2021-12-16 12:16 | 显示全部楼层
非常谢谢大侠分享
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 19:27 , Processed in 0.317862 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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