工程桩编号提取坐标

树櫴希德

2. ;;ssPts: 1 选择集，返回图元列表
   
3. ;;    2 点表(1到n维 1维时key只能是x或X)，返回点表
   
4. ;;   3 图元列表，返回图元列表
   
5. ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)
   
6. ;;FUZZ: 允许误差
   
7. ;;注:点表可以1到n维混合,Key长度不大于点的最小维数。
   
8. ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)
   
9. ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))
   
10. ;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)
    
11. ;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日
    
12. (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)
    
13.   ;;1 点列表排序
    
14.   (defun sortpts (PTS FUN xyz FUZZ)
    
15.     (vl-sort pts
    
16.       '(lambda (a b)
    
17.   (if (not (equal (xyz a) (xyz b) fuzz))
    
18.     (fun (xyz a) (xyz b))
    
19.   )
    
20.        )
    
21.     )
    
22.   )
    
23.   ;;2 排序
    
24.   (defun sortpts1 (PTS KEY FUZZ)
    
25.     (setq Key (vl-string->list Key))
    
26.     (foreach xyz (reverse Key)
    
27.       (cond ((< xyz 100)
    
28.       (setq fun >)
    
29.       (setq xyz (nth (- xyz 88) (list car cadr caddr)))
    
30.      )
    
31.      (T
    
32.       (setq fun <)
    
33.       (setq xyz (nth (- xyz 120) (list car cadr caddr)))
    
34.      )
    
35.       )
    
36.       (setq Pts (sortpts Pts fun xyz fuzz))
    
37.     )
    
38.   )
    
39.   ;;3 本程序主程序
    
40.   (cond ((= (type ssPts) 'PICKSET)
    
41.   (repeat (setq n (sslength ssPts))
    
42.     (if (and (setq e (ssname ssPts (setq n (1- n))))
    
43.       (setq en (entget e))
    
44.         )
    
45.       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
    
46.     )
    
47.   )
    
48.   (mapcar 'last (sortpts1 lst KEY FUZZ))
    
49. )
    
50. ((Listp ssPts)
    
51.   (cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
    
52.         ((= (type (car ssPts)) 'ENAME)
    
53.   (foreach e ssPts
    
54.     (if (setq en (entget e))        
    
55.       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))
    
56.     )
    
57.   )
    
58.   (mapcar 'last (sortpts1 lst KEY FUZZ))
    
59.         )
    
60.   )
    
61. )
    
62.   )
    
63. )
    
64. ;;*****************************************************************************通用点表排序
    
65. (defun c:gczbh1 (/     )
    
66. 
    
67. (setq blc (getint "\n请输入比例尺1:"))
    
68.   (setvar 'userr1 blc);设置比例尺
    
69. (setq zg(* 0.002 blc));字高
    
70. 
    
71. 
    
72. (defun get_inpoint (blockname)
    
73.   (setq in_point(cdr (assoc 10 (entget blockname))))
    
74.   in_point
    
75. )
    
76. 
    
77. 
    
78. (setq ss (ssget '((0 . "insert")))   )
    
79. (setq jidian (getpoint "请选择基点："))
    
80. (setq fangx (getpoint  jidian "请选择方向点："))
    
81. (setq angle1 (* (angle jidian fangx) 1))
    
82. (command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))
    
83. 
    
84. (setq i 0)
    
85. (setq lst '())
    
86. (repeat (sslength ss)
    
87. (setq insert_name (ssname ss i))
    
88. (setq e(get_inpoint insert_name))
    
89.   (setq lst (append lst (list e)))
    
90. (setq i (1+ i))
    
91. 
    
92. 
    
93.   )
    
94. 
    
95. (setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))
    
96. ;@树櫴希德 点表按照特定点逆时针排序~
    
97. ;(setq p (getpoint "\n指定排序方向"))
    
98. ;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))
    
99. 
    
100. 
     
101. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     
102. ;(setq ptlst (vl-sort (reverse lst)
     
103.                    ;以下根据x坐标对表排序
     
104.    ;'(lambda (e1 e2)
     
105.          ;   (< (car e1) (car e2) )
     
106.      ; (= (angle  e1 e2))   )   )    )
     
107. ;;;;;;;;;;;;;;;;;-----------------------------------
     
108. 
     
109. (setq ii 1)
     
110.   (setq  ff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w"))
     
111. (foreach n ptlst
     
112. 
     
113.    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (rtos ii 2 0))))
     
114. (setq nn (polar jidian (+ angle1 (angle jidian n)) (distance jidian n)  ))
     
115. (write-line (strcat (vl-princ-to-string ii)"," ","(vl-princ-to-string (car nn)) ","(vl-princ-to-string (cadr nn))","(vl-princ-to-string (caddr nn))
     
116. ) ff)
     
117.   
     
118. (setq ii (1+ ii))
     
119.     )
     
120.   (close ff)
     
121. 
     
122. 
     
123. 
     
124. 
     
125. 
     
126. )

;;ssPts: 1 选择集，返回图元列表<br /> ;;    2 点表(1到n维 1维时key只能是x或X)，返回点表<br /> ;;   3 图元列表，返回图元列表<br /> ;;Key: "xyzXYZ"任意组合,例如"yX",y在前表示y坐标优先，小y表示从小到大(注:二维点时，不能有z)<br /> ;;FUZZ: 允许误差<br /> ;;注:点表可以1到n维混合,Key长度不大于点的最小维数。<br /> ;;示例1 (HH:ssPts:Sort (ssget) "YxZ" 0.5);返回(<Entity name: 7ef7b3a8> <Entity name: 7ef7b3a0>)<br /> ;;示例2 (HH:ssPts:Sort (list '(2 3) '(3 5)) "Yx" 0.5);返回((3 5) (2 3))<br /> ;;示例3 (HH:ssPts:Sort '(<Entity name: 7ef79a28> <Entity name: 7ef79a10>) "YxZ" 0.5)<br /> ;;本程序是在fsxm的扩展 自贡黄明儒 2013年9月9日<br /> (defun HH:ssPts:Sort (ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS)<br />   ;;1 点列表排序<br />   (defun sortpts (PTS FUN xyz FUZZ)<br />     (vl-sort pts<br />       '(lambda (a b)<br />   (if (not (equal (xyz a) (xyz b) fuzz))<br />     (fun (xyz a) (xyz b))<br />   )<br />        )<br />     )<br />   )<br />   ;;2 排序<br />   (defun sortpts1 (PTS KEY FUZZ)<br />     (setq Key (vl-string->list Key))<br />     (foreach xyz (reverse Key)<br />       (cond ((< xyz 100)<br />       (setq fun >)<br />       (setq xyz (nth (- xyz 88) (list car cadr caddr)))<br />      )<br />      (T<br />       (setq fun <)<br />       (setq xyz (nth (- xyz 120) (list car cadr caddr)))<br />      )<br />       )<br />       (setq Pts (sortpts Pts fun xyz fuzz))<br />     )<br />   )<br />   ;;3 本程序主程序<br />   (cond ((= (type ssPts) 'PICKSET)<br />   (repeat (setq n (sslength ssPts))<br />     (if (and (setq e (ssname ssPts (setq n (1- n))))<br />       (setq en (entget e))<br />         )<br />       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))<br />     )<br />   )<br />   (mapcar 'last (sortpts1 lst KEY FUZZ))<br /> )<br /> ((Listp ssPts)<br />   (cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))<br />         ((= (type (car ssPts)) 'ENAME)<br />   (foreach e ssPts<br />     (if (setq en (entget e))        <br />       (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))<br />     )<br />   )<br />   (mapcar 'last (sortpts1 lst KEY FUZZ))<br />         )<br />   )<br /> )<br />   )<br /> )<br /> ;;*****************************************************************************通用点表排序<br /> (defun c:gczbh1 (/     )<br /> <br /> (setq blc (getint "\n请输入比例尺1:"))<br />   (setvar 'userr1 blc);设置比例尺<br /> (setq zg(* 0.002 blc));字高<br /> <br /> <br /> (defun get_inpoint (blockname)<br />   (setq in_point(cdr (assoc 10 (entget blockname))))<br />   in_point<br /> )<br /> <br /> <br /> (setq ss (ssget '((0 . "insert")))   )<br /> (setq jidian (getpoint "请选择基点："))<br /> (setq fangx (getpoint  jidian "请选择方向点："))<br /> (setq angle1 (* (angle jidian fangx) 1))<br /> (command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))<br /> <br /> (setq i 0)<br /> (setq lst '())<br /> (repeat (sslength ss)<br /> (setq insert_name (ssname ss i))<br /> (setq e(get_inpoint insert_name))<br />   (setq lst (append lst (list e)))<br /> (setq i (1+ i))<br /> <br /> <br />   )<br /> <br /> (setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))<br /> ;@树櫴希德 点表按照特定点逆时针排序~<br /> ;(setq p (getpoint "\n指定排序方向"))<br /> ;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))<br /> <br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;(setq ptlst (vl-sort (reverse lst)<br />                    ;以下根据x坐标对表排序<br />    ;'(lambda (e1 e2)<br />          ;   (< (car e1) (car e2) )<br />      ; (= (angle  e1 e2))   )   )    )<br /> ;;;;;;;;;;;;;;;;;-----------------------------------<br /> <br /> (setq ii 1)<br />   (setq  ff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w")) <br /> (foreach n ptlst<br /> <br />    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (rtos ii 2 0))))<br /> (setq nn (polar jidian (+ angle1 (angle jidian n)) (distance jidian n)  ))<br /> (write-line (strcat (vl-princ-to-string ii)"," ","(vl-princ-to-string (car nn)) ","(vl-princ-to-string (cadr nn))","(vl-princ-to-string (caddr nn))<br /> ) ff)<br />   <br /> (setq ii (1+ ii))<br />     )<br />   (close ff)<br /> <br /> <br /> <br /> <br /> <br /> )

树櫴希德

2. 
   
3. (defun c:gczbh1 (/ p qianzhui blc zg ss i lst e kkkk ptlst ff )
   
4. 
   
5. (setq blc (getint "\n请输入比例尺1:"))
   
6.   (setvar 'userr1 blc);设置比例尺
   
7. (setq zg(* 0.002 blc));字高
   
8. 
   
9. 
   
10. (defun get_inpoint (blockname)
    
11.   (setq in_point(cdr (assoc 10 (entget blockname))))
    
12.   in_point
    
13. )
    
14. 
    
15. 
    
16. (setq ss (ssget '((0 . "insert")))   )
    
17. ;(setq jidian (getpoint "请选择基点："))
    
18. ;(setq fangx (getpoint  jidian "请选择方向点："))
    
19. ;(setq angle1 (* (angle jidian fangx) 1))
    
20. ;(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))
    
21. 
    
22. (setq i 0)
    
23. (setq lst '())
    
24. (repeat (sslength ss)
    
25. (setq insert_name (ssname ss i))
    
26. (setq e(get_inpoint insert_name))
    
27.   (setq lst (append lst (list e)))
    
28. (setq i (1+ i))
    
29. 
    
30. 
    
31.   )
    
32. 
    
33. ;(setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))
    
34. ;@树櫴希德 点表按照特定点逆时针排序~
    
35. (setq p (getpoint "\n指定排序方向"))
    
36. (setq qianzhui  (getstring "\n请输入前缀："))
    
37. ;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))
    
38. 
    
39. 
    
40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
41. (setq ptlst (vl-sort (reverse lst)
    
42.                    ;以下根据x坐标对表排序
    
43.    '(lambda (e1 e2)
    
44.             (< (car e1) (car e2) )
    
45.       (= (angle  e1 p))   )   )    )
    
46. ;;;;;;;;;;;;;;;;;-----------------------------------
    
47. 
    
48. 
    
49. (initget "1 2")
    
50.   (prompt "\n坐标是否缩小1000倍:")
    
51.   (setq kkkk (getkword "\n 1. 不用缩小1000倍　　\  2. 缩小1000倍：<1>"))
    
52.   (if (= kkkk nil) (setq kkkk "1"))
    
53.   (setq ii 1)
    
54.   (setq  ff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w"))
    
55. ( cond ((= kkkk "1")
    
56.    (progn
    
57. (foreach n ptlst
    
58. 
    
59.    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (strcat qianzhui (rtos ii 2 0))   )))
    
60. 
    
61. (write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (car n)) ","(vl-princ-to-string (cadr n))","(vl-princ-to-string (caddr n))
    
62. ) ff)
    
63.   
    
64. (setq ii (1+ ii))
    
65.     )(close ff)  ))
    
66. ( (= kkkk "2")
    
67. (progn
    
68. (foreach n ptlst
    
69. 
    
70.    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 (* 1000 zg))(cons 1 (strcat qianzhui (rtos ii 2 0))   )))
    
71. 
    
72. (write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (/ (car n) 1000)) ","(vl-princ-to-string (/ (cadr n) 1000))","(vl-princ-to-string (/ (caddr n) 1000))
    
73. ) ff)
    
74.   
    
75. (setq ii (1+ ii))
    
76.     )  (close ff)
    
77. )
    
78.   )
    
79. 
    
80.    
    
81. 
    
82. )
    
83.   
    
84.   
    
85. 
    
86. 
    
87. 
    
88. 
    
89. 
    
90. )

<br /> (defun c:gczbh1 (/ p qianzhui blc zg ss i lst e kkkk ptlst ff )<br /> <br /> (setq blc (getint "\n请输入比例尺1:"))<br />   (setvar 'userr1 blc);设置比例尺<br /> (setq zg(* 0.002 blc));字高<br /> <br /> <br /> (defun get_inpoint (blockname)<br />   (setq in_point(cdr (assoc 10 (entget blockname))))<br />   in_point<br /> )<br /> <br /> <br /> (setq ss (ssget '((0 . "insert")))   )<br /> ;(setq jidian (getpoint "请选择基点："))<br /> ;(setq fangx (getpoint  jidian "请选择方向点："))<br /> ;(setq angle1 (* (angle jidian fangx) 1))<br /> ;(command "_.rotate" ss "" jidian "r" jidian fangx (polar jidian 0 100))<br /> <br /> (setq i 0)<br /> (setq lst '())<br /> (repeat (sslength ss)<br /> (setq insert_name (ssname ss i))<br /> (setq e(get_inpoint insert_name))<br />   (setq lst (append lst (list e)))<br /> (setq i (1+ i))<br /> <br /> <br />   )<br /> <br /> ;(setq ptlst (HH:ssPts:Sort lst "xyz" 0.0))<br /> ;@树櫴希德 点表按照特定点逆时针排序~<br /> (setq p (getpoint "\n指定排序方向"))<br /> (setq qianzhui  (getstring "\n请输入前缀："))<br /> ;(setq ptlst(mapcar 'cdr (vl-sort (mapcar 'cons (mapcar '(lambda(x) (angle x p)) lst) lst) '(lambda (x y) (< (car x) (car y))))))<br /> <br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (setq ptlst (vl-sort (reverse lst)<br />                    ;以下根据x坐标对表排序<br />    '(lambda (e1 e2)<br />             (< (car e1) (car e2) )<br />       (= (angle  e1 p))   )   )    )<br /> ;;;;;;;;;;;;;;;;;-----------------------------------<br /> <br /> <br /> (initget "1 2")<br />   (prompt "\n坐标是否缩小1000倍:")<br />   (setq kkkk (getkword "\n 1. 不用缩小1000倍　　\  2. 缩小1000倍：<1>"))<br />   (if (= kkkk nil) (setq kkkk "1"))<br />   (setq ii 1)<br />   (setq  ff (open (getfiled "请输入要保存的数据文件名" "" "dat" 1) "w"))<br /> ( cond ((= kkkk "1")<br />    (progn<br /> (foreach n ptlst<br /> <br />    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 zg)(cons 1 (strcat qianzhui (rtos ii 2 0))   )))<br /> <br /> (write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (car n)) ","(vl-princ-to-string (cadr n))","(vl-princ-to-string (caddr n))<br /> ) ff)<br />   <br /> (setq ii (1+ ii))<br />     )(close ff)  ))<br /> ( (= kkkk "2")<br /> (progn<br /> (foreach n ptlst<br /> <br />    (entmake (list '(0 . "text") (cons 10 n) '(7 . "HZ") (cons 40 (* 1000 zg))(cons 1 (strcat qianzhui (rtos ii 2 0))   )))<br /> <br /> (write-line (strcat qianzhui (vl-princ-to-string ii)"," ","(vl-princ-to-string (/ (car n) 1000)) ","(vl-princ-to-string (/ (cadr n) 1000))","(vl-princ-to-string (/ (caddr n) 1000))<br /> ) ff)<br />   <br /> (setq ii (1+ ii))<br />     )  (close ff)<br /> )<br />   )<br /> <br />    <br /> <br /> )<br />   <br />   <br /> <br /> <br /> <br /> <br /> <br /> )

gzxl

楼主研究精神值得我们学习

ji3499222

楼主，不知道怎么使用。

lgzh0008

楼主，不知道怎么使用。

skg123

楼主，你做成附件，供新手下载。比如 lgzh0008 他知道怎么使用。

dwjb

楼主是孤独求败

zhenz02

感谢楼主分享

tigcat

这个要针对桩做成块才行，还有就是原图没有标注字出来，不知道哪里搞错了

tigcat

看了代码，应该字体中要有hz这个样式才行，等回去试试