奇葩水深点生成数据文件，求改进

树櫴希德

2. (DEFUN VXS (E /)
   
3.       (CDR (ASSOC 10 (ENTGET E)))
   
4. 
   
5. 
   
6.   )
   
7. (DEFUN VXS1 (E /)
   
8.       (CDR (ASSOC 1 (ENTGET E)))
   
9. 
   
10. 
    
11.   )
    
12. (defun get_inpoint (blockname)
    
13.   (setq in_point(cdr (assoc 10 (entget blockname))))
    
14.   in_point
    
15. )
    
16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
17. (defun get_inpointname (blockname)
    
18.   (setq in_point(cdr(car(entget blockname))))
    
19.   in_point
    
20. )
    
21. 
    
22. 
    
23. 
    
24. (setq ssa (ssget '((0 . "TEXT") (8 . "0"))))
    
25.                 (setq ii   0
    
26.                       no  0
    
27.                   )
    
28.                   (repeat (sslength ssa)
    
29.                        (setq en (ssname ssa ii)
    
30.                             ptb (vxs en)
    
31.           pzx (append pzx (list ptb))
    
32.            ii  (1+ ii)               )
    
33.         )
    
34. 
    
35. (setq pzx1(getpoint "\n 文字起点"))
    
36. (setq pzx2(getpoint "\n 第二文字终点"))
    
37. 
    
38. (setq lst(vl-sort pzx'(lambda(x y)(and (equal (distance pzx1 pzx2) (distance x y) 0.3)
    
39. 
    
40.                                        (equal (angle pzx1 pzx2) (angle x y) 0.002)
    
41. 
    
42.             (<(car x)(car y))(>(cadr x)(cadr y))
    
43.                )      )))
    
44. 
    
45. 
    
46. 
    
47. 
    
48. 
    
49. (defun divlst(lst n / a b)
    
50.     (while lst(setq b nil)
    
51.       (repeat(min(length lst)n)(setq b(cons(car lst) b)lst(cdr lst)))
    
52.       (setq a(cons b a)))
    
53.     (mapcar'reverse(reverse a)))
    
54. 
    
55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
56. (defun testlsp(lst x1 x2 / a b d l)
    
57.   (setq lst(vl-sort lst'(lambda(x y)(and(<(car x)(car y))(<(cadr x)(cadr y)))))
    
58. d(distance x1 x2))
    
59.   (while lst
    
60.     (if(setq a(car lst)
    
61.      b(vl-remove-if-not'(lambda(x)(equal(distance x a)d 0.3))(cdr lst)))
    
62.       (setq b(cons a b)
    
63.     l(cons b l)
    
64.     lst(repeat(length b)
    
65. (setq a(car b)
    
66.        b(cdr b)
    
67.        lst(vl-remove a lst))))
    
68.       (setq lst(cdr lst))))
    
69.   l)
    
70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
71. 
    
72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
73. 
    
74.   
    
75. ;(setq lst nil  newlst nil x1 0)
    
76. (setq fp(getfiled "打开数据文件" "C:\" "dat" 5)
    
77.   fp(if fp(open fp"w")))
    
78. (foreach x (testlsp lst pzx1 pzx2)
    
79.   
    
80. (repeat (setq k (sslength ssa))
    
81.     (if  (and (setq e (ssname ssa (setq k (1- k ))))
    
82.        (setq en (entget e))
    
83.   )
    
84.       (progn  
    
85.   
    
86.   (if (member (cons 10 (car x)) en)
    
87.     (setq pzx3(VXS1 e))
    
88.     ;(setq en (cons x en))
    
89.   )
    
90.       )
    
91.     )
    
92.   )
    
93.   
    
94. (repeat (setq k (sslength ssa))
    
95.     (if  (and (setq e (ssname ssa (setq k (1- k ))))
    
96.        (setq en (entget e))
    
97.   )
    
98.       (progn  
    
99.   
    
100.   (if (member (cons 10 (cadr x)) en)
     
101.     (setq pzx4(VXS1 e))
     
102.     ;(setq en (cons x en))
     
103.   )
     
104.       )
     
105.     )
     
106.   )
     
107. 
     
108.   (setq pzx5(mapcar '(lambda(x y) (* 0.5(+ x y))  )(car x)  (cadr x)  ))
     
109. 
     
110.   (setq pzx6(strcat "0" ",,"(rtos (car pzx5)2 3)","(rtos (cadr pzx5)2 3)","(strcat pzx3"."pzx4)"\n"))
     
111. 
     
112. ;(command "rectangle" (car x) (cadr x))
     
113. 
     
114. (write-line pzx6 fp)
     
115.   
     
116. 
     
117.   )
     
118. 
     
119. 
     
120. (close fp)
     

(DEFUN VXS (E /)<br />       (CDR (ASSOC 10 (ENTGET E)))<br /> <br /> <br />   )<br /> (DEFUN VXS1 (E /)<br />       (CDR (ASSOC 1 (ENTGET E)))<br /> <br /> <br />   )<br /> (defun get_inpoint (blockname)<br />   (setq in_point(cdr (assoc 10 (entget blockname))))<br />   in_point<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun get_inpointname (blockname)<br />   (setq in_point(cdr(car(entget blockname))))<br />   in_point<br /> )<br /> <br /> <br /> <br /> (setq ssa (ssget '((0 . "TEXT") (8 . "0"))))<br />                 (setq ii   0<br />                       no  0<br />                   )<br />                   (repeat (sslength ssa)<br />                        (setq en (ssname ssa ii)<br />                             ptb (vxs en)<br />           pzx (append pzx (list ptb))<br />            ii  (1+ ii)               )<br />         )<br /> <br /> (setq pzx1(getpoint "\n 文字起点"))<br /> (setq pzx2(getpoint "\n 第二文字终点"))<br /> <br /> (setq lst(vl-sort pzx'(lambda(x y)(and (equal (distance pzx1 pzx2) (distance x y) 0.3)<br /> <br />                                        (equal (angle pzx1 pzx2) (angle x y) 0.002)<br /> <br />             (<(car x)(car y))(>(cadr x)(cadr y))<br />                )      )))<br /> <br /> <br /> <br /> <br /> <br /> (defun divlst(lst n / a b)<br />     (while lst(setq b nil)<br />       (repeat(min(length lst)n)(setq b(cons(car lst) b)lst(cdr lst)))<br />       (setq a(cons b a)))<br />     (mapcar'reverse(reverse a)))<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun testlsp(lst x1 x2 / a b d l)<br />   (setq lst(vl-sort lst'(lambda(x y)(and(<(car x)(car y))(<(cadr x)(cadr y)))))<br /> d(distance x1 x2))<br />   (while lst<br />     (if(setq a(car lst)<br />      b(vl-remove-if-not'(lambda(x)(equal(distance x a)d 0.3))(cdr lst)))<br />       (setq b(cons a b)<br />     l(cons b l)<br />     lst(repeat(length b)<br /> (setq a(car b)<br />        b(cdr b)<br />        lst(vl-remove a lst))))<br />       (setq lst(cdr lst))))<br />   l)<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> <br />   <br /> ;(setq lst nil  newlst nil x1 0)<br /> (setq fp(getfiled "打开数据文件" "C:\" "dat" 5)<br />   fp(if fp(open fp"w")))<br /> (foreach x (testlsp lst pzx1 pzx2)<br />   <br /> (repeat (setq k (sslength ssa))<br />     (if  (and (setq e (ssname ssa (setq k (1- k ))))<br />        (setq en (entget e))<br />   )<br />       (progn  <br />   <br />   (if (member (cons 10 (car x)) en)<br />     (setq pzx3(VXS1 e))<br />     ;(setq en (cons x en))<br />   )<br />       )<br />     )<br />   )<br />   <br /> (repeat (setq k (sslength ssa))<br />     (if  (and (setq e (ssname ssa (setq k (1- k ))))<br />        (setq en (entget e))<br />   )<br />       (progn  <br />   <br />   (if (member (cons 10 (cadr x)) en)<br />     (setq pzx4(VXS1 e))<br />     ;(setq en (cons x en))<br />   )<br />       )<br />     )<br />   )<br /> <br />   (setq pzx5(mapcar '(lambda(x y) (* 0.5(+ x y))  )(car x)  (cadr x)  ))<br /> <br />   (setq pzx6(strcat "0" ",,"(rtos (car pzx5)2 3)","(rtos (cadr pzx5)2 3)","(strcat pzx3"."pzx4)"\n"))<br /> <br /> ;(command "rectangle" (car x) (cadr x))<br /> <br /> (write-line pzx6 fp)<br />   <br /> <br />   )<br /> <br /> <br /> (close fp)<br />

llsheng_73

1当小数部分为0时，不会出现代表小数的文字。这种情况下需要设置小数为0而不是将其排除，其点位可参考前一点计算出的位置
2不是所有整数部分和小数部分两个文字的插入坐标差值都是相同的。所以整数和小数的匹配是一个问题，可以考虑采用代表整数和小数的文字的距离不超过多少并且小数在右边进行组合，而不是采用固定的距离和角度
进行限制，另外，对于点位的计算如果考虑整数多于一位的情况刚不能用这两个文字的10组取中数
3程序基本无章法，这方面需要提高，比如反复写同一个东东或者不断修改已经写经写好的程序

树櫴希德

llsheng_73 发表于 2016-1-3 18:18
1当小数部分为0时，不会出现代表小数的文字。这种情况下需要设置小数为0而不是将其排除，其点位可参考前一点 ...

是啊。我主要是看这个烂图气人，完成大部分，其它自己搞。希望烂图千年一遇

知行ooo李肖坪

同步学习中………………

gzxl

烂图

冰神

这是海图水深的标准标法呀~~~

song宋_74729

如何做到的請大哥教一下