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

树櫴希德

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

;;打点检查之输出点位坐标<br /> (defun c:zdhsc(/ zdh_ss fileneme zdhn len f pp x y xystr)<br /> (setq zdh_ss (ssget "X" (list (cons 0 "point") (cons 8 "zdh"))))<br /> (if zdh_ss (progn<br /> (setq filename (getfiled "输入要保存的数据文件名<.txt>:" "d:/" "txt" 5))<br /> (if filename (progn<br /> (setq zdhn 0 len (sslength zdh_ss))<br /> (setq f (open filename "w"))<br /> (while (< zdhn len)<br /> (setq pp (cdr (assoc '10 (entget (ssname zdh_ss zdhn)))))<br /> (setq x (rtos (cadr pp) 2 3) y (rtos (car pp) 2 3))<br /> (setq zdhn (+ zdhn 1))<br /> (setq xystr (strcat (itoa zdhn) " " x " " y))<br /> (write-line xystr f)<br /> );while<br /> (setq zdh_ss nil)<br /> (close f)<br /> (princ (strcat "\n共输出" (itoa len) "个点的坐标成果，成果文件为:" filename))<br /> );progn<br /> (princ "\n未设置文件名，未进行坐标输出操作。")<br /> );if<br /> );progn<br /> (princ "\n图形中没有任何点位!")<br /> );if<br /> (princ)<br /> );defun<br /> ;;---------------------------------------------------------------------------------<br /> (DEFUN sh_ch ( LST /  )<br /> (COMMAND "_.ZOOM" "C" LST "1")<br />   )<br /> ;;打点检查之形成坐标分析文件<br /> (defun c:ddjc()<br /> (setq filename (getfiled "选择检查点的坐标数据文件名<.txt>:" "" "txt" 0))<br /> (if filename (progn<br /> (setq ddlist nil endk 0 nddlist nil)<br /> (setq f (open filename "r"))<br /> (while (setq ddstr (read-line f))<br /> (setq ddstr (strcat "(" ddstr ")"))<br /> (if (= ddlist nil)<br /> (setq ddlist (list (reverse (read ddstr))))<br /> (setq ddlist (cons (reverse (read ddstr)) ddlist))<br /> );if<br /> );while<br /> (close f)<br /> (if ddlist (progn<br /> (setq ddlist (reverse ddlist) ddnn 0 len (length ddlist))<br /> (if (= ddn nil) (setq ddn 0))<br /> (while (= ddnn 0)<br /> (setq ddnn (getint (strcat "\n共" (itoa len) "个点，请选择从第几个点开始<" (itoa (+ ddn 1)) ">:")))<br /> (if (= ddnn nil) (setq ddnn (+ ddn 1)))<br /> (if (and (> ddnn 0) (< ddnn (+ len 1))) (setq ddn (- ddnn 1)) (setq ddnn 0))<br /> );while<br /> (while (and (< ddn len) (/= endk 1))<br /> (setq po_all (list (reverse (cdr (reverse (nth ddn ddlist))))))<br /> (sh_ch (CAR po_all))<br /> (initget "U S B")<br /> (princ (strcat "\n共" (itoa len) "个点，现在是第" (itoa (+ ddn 1)) "个点。"))<br /> (setq pp (getpoint "\n回到上一点（U）/跳过此点（S）/作标记并跳过此点（B）<采集原坐标点或空回车结束>:"))<br /> (cond (( = pp "U")<br />        (if (/= (+ ddn 1) ddnn) (progn<br />        (setq ddn (- ddn 1))<br />        (if (and nddlist (= (nth 0 (nth 0 nddlist)) (nth 2 (nth ddn ddlist))))<br />        (setq nddlist (cdr nddlist))<br />        );if<br />        );progn<br />        (princ "\已不能回退!")<br />        );if<br />       )<br />       ((= pp "S")<br />        (setq ddn (+ ddn 1))<br />       )<br />       ((= pp "B")<br />        (setq p0 (reverse (cdr (reverse (nth ddn ddlist)))))<br />        (entmake (list (cons 0 "CIRCLE") (cons 8 "标记") (cons 62 1) (cons 10 p0) (cons 40 0.5)))<br />        (setq ddn (+ ddn 1))<br />       )<br />       ((= pp nil)<br />        (initget "Y N")<br />        (setq ddkey (getkword "\n是否是否要结束取点？是（Y）/否（N）<N>:"))<br />        (if (= ddkey "Y") (setq endk 1))<br />       )<br />       ((= (type pp) (type (list 1 1)))<br />        (entmake (list (cons 0 "CIRCLE") (cons 8 "0") (cons 62 3) (cons 10 pp) (cons 40 0.05)))<br />        (initget "Y N")<br />        (setq ddkey (getkword "\n是否为小绿色标记圆的点，是（Y）/否（N）<Y>:"))<br />        (command "erase" (entlast) "")<br />        (if (or (= ddkey nil) (= ddkey "Y")) (progn<br />        (setq pp (cons (nth 2 (nth ddn ddlist)) pp))<br />        (if nddlist (setq nddlist (cons pp nddlist)) (setq nddlist (list pp)))<br />        (setq ddn (+ ddn 1))<br />        ));if<br />       )<br /> );cond<br /> );while<br /> (if nddlist (progn<br /> (princ (strcat "\n共采集到" (itoa (length nddlist)) "个原坐标点。"))<br /> (setq filename nil nddlist (reverse nddlist))<br /> (initget "X A W")<br /> (setq ddkey (getkword "\n不保存数据退出（X）/追加保存数据（A）/覆盖保存数据（W）<W>:"))<br /> (if (= ddkey nil) (setq ddkey "W"))<br /> (if (= ddkey "W")<br /> (setq filename (getfiled "选择数据文件名<.txt>:" "" "txt" 5))<br /> );if<br /> (if (= ddkey "A")<br /> (setq filename (getfiled "选择数据文件名<.txt>:" "" "txt" 0))<br /> );if<br /> (if filename (progn<br /> (setq zn 0 ddnn 0)<br /> (if (= ddkey "A") (progn<br /> (setq f (open filename "r"))<br /> (while (setq ddstr (read-line f)) <br /> (setq zn (+ zn 1))<br /> );while<br /> (close f)<br /> );progn<br /> );if<br /> (setq f (open filename ddkey))<br /> (while (and (/= ddkey "X") (< ddnn (length nddlist)))<br /> (setq pp (nth ddnn nddlist))<br /> (setq n (nth 0 pp))<br /> (setq pp1 (nth (- n 1) ddlist))<br /> (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)))<br /> (write-line ddstr f)<br /> (setq ddnn (+ ddnn 1))<br /> );while<br /> (close f)<br /> (princ (strcat "\n数据已保存在" filename "，文件中共有" (itoa (+ ddnn zn)) "个点的坐标检查数据。"))<br /> );progn<br /> (if (and (/= ddkey "X") (= filename nil)) (princ "\n未选择文件名，数据未保存!") (princ "\n程序已退出，数据未保存!"))<br /> );if<br /> );progn<br /> (princ "\n没有采集到原坐标点!")<br /> );if<br /> );progn<br /> (princ (strcat "\n" filename "中没有坐标数据!"))<br /> );if<br /> );progn<br /> (princ "\n未设置检查点的坐标数据文件，未进行任何操作。")<br /> );if<br /> (princ)<br /> );defun

暮雨寒阳

能讲解一下功能吗？有点每太看懂，最好是配个演示

scwdb809

10多年前的老程序了，发帖人应尊重原代码编写人的劳动成果！

gzbccy

没有演示，不知道是干嘛用的！[em0]

测不准

南方Cass有这个功能

zst1978

非常谢谢大侠分享

gwar

非常谢谢大侠分享