请问，能不能实现以下功能。

citykunan

请问各位版主，有没有什么好的办法，可以实现在网格上自动判断网格间的距离，根据
不同的网格间的距离插入相应的块，网格不是规则的。块已经事先做好了。

谢谢各位。

citykunan

各位高手只要给个思路就可以。

meflying

你先试试，总觉得有些问题，可却无法改正
调试图，注意块的名字

2. 
   
3. 
   
4. (defun Getinterpoints (ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)
   
5.   (setq e1 (entget ent1))
   
6.   (setq e2 (entget ent2))
   
7.   (setq pt1 (cdr (assoc 10 e1)))
   
8.   (setq pt2 (cdr (assoc 11 e1)))
   
9.   (setq pt3 (cdr (assoc 10 e2)))
   
10.   (setq pt4 (cdr (assoc 11 e2)))
    
11.   (inters pt1 pt2 pt3 pt4)
    
12. )
    
13. 
    
14. (defun GetAllInters (ss / n i j ent1 ent2 points point)
    
15.   (setq n (sslength ss))
    
16.   (setq        i 0
    
17.         j 0
    
18.   )
    
19.   (while (< i n)
    
20.     (setq j (1+ i))
    
21.     (setq ent1 (ssname ss i))
    
22.     (while (< j n)
    
23.       (setq ent2 (ssname ss j))
    
24.       (if (setq point (getinterpoints ent1 ent2))
    
25.         (setq points (append points (list point)))
    
26.       )
    
27.       (setq j (1+ j))
    
28.     )
    
29.     (setq i (1+ i))
    
30.   )
    
31.   points
    
32. )
    
33. 
    
34. (defun c:test (/ ss n i pts pt pt_next dist BlkName)
    
35.   (setq os (getvar "osmode"))
    
36.   (setq cmd (getvar "cmdecho"))
    
37.   (setq ss (ssget '((0 . "LINE"))))
    
38.   (command "_.undo" "be")
    
39.   (setvar "osmode" 0)
    
40.                                         ;(setvar "cmdecho" 0)
    
41.   (setq pts (GetAllInters ss))
    
42.   (setq pts (vl-sort pts '(lambda (e1 e2) (< (car e1) (car e2)))))
    
43.   (setq pts (vl-sort pts '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
    
44.   (setq n (length pts))
    
45.   (setq i 0)
    
46. 
    
47.   (while (< i (1- n))
    
48.     (setq pt (nth i pts))
    
49.     (setq pt_next (nth (1+ i) pts))
    
50.     (if        (equal (cadr pt) (cadr pt_next))
    
51.       (progn
    
52.         (setq dist (distance pt pt_next))
    
53.         (cond
    
54.           ((equal dist 5 0.00000001) (setq BlkName "Len5"))
    
55.           ((equal dist 11 0.00000001) (setq BlkName "Len11"))
    
56.         )
    
57.         (command "_.insert"
    
58.                  BlkName
    
59.                  (list (/ (+ (car pt) (car pt_next)) 2)
    
60.                        (/ (+ (cadr pt) (cadr pt_next)) 2)
    
61.                  )
    
62.                  ""
    
63.                  ""
    
64.                  ""
    
65.         )
    
66.       )
    
67.     )
    
68.     (setq i (1+ i))
    
69.   )
    
70.   (setq pts (vl-sort pts '(lambda (e1 e2) (< (car e1) (car e2)))))
    
71.   (setq i 0)
    
72.   (while (< i (1- n))
    
73.     (setq pt (nth i pts))
    
74.     (setq pt_next (nth (1+ i) pts))
    
75.     (if        (equal (car pt) (car pt_next))
    
76.       (progn
    
77.         (setq dist (distance pt pt_next))
    
78.         (cond
    
79.           ((equal dist 5) (setq BlkName "Len5"))
    
80.           ((equal dist 11) (setq BlkName "Len11"))
    
81.         )
    
82.         (command "_.insert"
    
83.                  BlkName
    
84.                  (list (/ (+ (car pt) (car pt_next)) 2)
    
85.                        (/ (+ (cadr pt) (cadr pt_next)) 2)
    
86.                  )
    
87.                  ""
    
88.                  ""
    
89.                  "90"
    
90.         )
    
91.       )
    
92.     )
    
93.     (setq i (1+ i))
    
94.   )
    
95.   (command "_.undo" "e")
    
96.   (setvar "osmode" os)
    
97.   (setvar "cmdecho" cmd)
    
98.   (princ)
    
99. )
    

<br /> <br /> (defun Getinterpoints (ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)<br />   (setq e1 (entget ent1))<br />   (setq e2 (entget ent2))<br />   (setq pt1 (cdr (assoc 10 e1)))<br />   (setq pt2 (cdr (assoc 11 e1)))<br />   (setq pt3 (cdr (assoc 10 e2)))<br />   (setq pt4 (cdr (assoc 11 e2)))<br />   (inters pt1 pt2 pt3 pt4)<br /> )<br /> <br /> (defun GetAllInters (ss / n i j ent1 ent2 points point)<br />   (setq n (sslength ss))<br />   (setq        i 0<br />         j 0<br />   )<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq ent1 (ssname ss i))<br />     (while (< j n)<br />       (setq ent2 (ssname ss j))<br />       (if (setq point (getinterpoints ent1 ent2))<br />         (setq points (append points (list point)))<br />       )<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   points<br /> )<br /> <br /> (defun c:test (/ ss n i pts pt pt_next dist BlkName)<br />   (setq os (getvar "osmode"))<br />   (setq cmd (getvar "cmdecho"))<br />   (setq ss (ssget '((0 . "LINE"))))<br />   (command "_.undo" "be")<br />   (setvar "osmode" 0)<br />                                         ;(setvar "cmdecho" 0)<br />   (setq pts (GetAllInters ss))<br />   (setq pts (vl-sort pts '(lambda (e1 e2) (< (car e1) (car e2)))))<br />   (setq pts (vl-sort pts '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))<br />   (setq n (length pts))<br />   (setq i 0)<br /> <br />   (while (< i (1- n))<br />     (setq pt (nth i pts))<br />     (setq pt_next (nth (1+ i) pts))<br />     (if        (equal (cadr pt) (cadr pt_next))<br />       (progn<br />         (setq dist (distance pt pt_next))<br />         (cond<br />           ((equal dist 5 0.00000001) (setq BlkName "Len5"))<br />           ((equal dist 11 0.00000001) (setq BlkName "Len11"))<br />         )<br />         (command "_.insert"<br />                  BlkName<br />                  (list (/ (+ (car pt) (car pt_next)) 2)<br />                        (/ (+ (cadr pt) (cadr pt_next)) 2)<br />                  )<br />                  ""<br />                  ""<br />                  ""<br />         )<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq pts (vl-sort pts '(lambda (e1 e2) (< (car e1) (car e2)))))<br />   (setq i 0)<br />   (while (< i (1- n))<br />     (setq pt (nth i pts))<br />     (setq pt_next (nth (1+ i) pts))<br />     (if        (equal (car pt) (car pt_next))<br />       (progn<br />         (setq dist (distance pt pt_next))<br />         (cond<br />           ((equal dist 5) (setq BlkName "Len5"))<br />           ((equal dist 11) (setq BlkName "Len11"))<br />         )<br />         (command "_.insert"<br />                  BlkName<br />                  (list (/ (+ (car pt) (car pt_next)) 2)<br />                        (/ (+ (cadr pt) (cadr pt_next)) 2)<br />                  )<br />                  ""<br />                  ""<br />                  "90"<br />         )<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (command "_.undo" "e")<br />   (setvar "osmode" os)<br />   (setvar "cmdecho" cmd)<br />   (princ)<br /> )<br />

citykunan

多谢版主，我先试试。

citykunan

我昨天仔细研究了一下飞版主的程序。程序很不错，但好像还是有点问题。
这个程序难就难在怎样将很多的交点进行合理的排序， 飞版主的程序中
(setq pts (vl-sort pts '(lambda (e1 e2) (< (car e1) (car e2)))))
  (setq pts (vl-sort pts '(lambda (e1 e2) (< (cadr e1) (cadr e2)))))
是为了排序，但好像没有达到预期的效果。不知各位版主还有什么高招吗？
谢谢各位。

meflying

我也搞不清楚这个排序为什么没有得到正确的结果，试了很长时间，总是有几个点排列错误。
不知是不是进入误区了，自己出不来了，谁有空可以看看

无痕

两个排序不能连续用
一个排好后，在按照car相同的进行cadr排序，car不相同的不能放到一次排序的行列里面

citykunan

无痕游侠能不能说的详细一点？我看过飞版主的排序，先是按x的坐标排，小的排在前面，
在排y坐标，小的放在前面，没有发现什么错。请看下图



!pts的值，完全符合排列规律。但却达不到效果。
((0.0 0.0 0.0) (0.0 11.0 0.0) (0.0 22.0 0.0) (11.0 0.0 0.0) (11.0
11.0 0.0) (11.0 22.0 0.0) (16.0 0.0 0.0) (16.0 11.0 0.0) (22.0 11.0 0.0) (22.0
22.0 0.0) (27.0 0.0 0.0) (27.0 11.0 0.0) (33.0 11.0 0.0) (33.0 22.0 0.0) (38.0
0.0 0.0) (38.0 11.0 0.0) (44.0 11.0 0.0) (44.0 22.0 0.0) (49.0 0.0 0.0) (49.0
11.0 0.0))

龙龙仔

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=2521

meflying

问题解决了，主要是CAD处理数据精度问题。比如两个X坐标相同的点，经过它提取和计算后，他们的坐标会有一些差异，当然这个差异是很小的，基本上不影响我们的使用。但在排序时，我们认为这两个坐标的X值相同，不要重新排列了，但CAD却应该有这么一点差异，比较它们的大小，重新排列了顺序。
所以我做了一个有精度控制的大于和小于的函数，就是小于时，要小到某一精度才算比它小，否则，还算等于。。。

to 无痕，你的说法我有些不赞同。。。

程序如下：

2. 
   
3. 
   
4. (defun Wl-equal(Val1 Val2 fun fuzz)
   
5.   (cond
   
6.     ((= fun "=") (equal Val1 Val2 fuzz) t)
   
7.     ((= fun "<") (cond
   
8.                    ((equal Val1 Val2 fuzz) nil)
   
9.                    ((< Val1 Val2) t)))
   
10.     ((= fun ">" (cond
    
11.                   ((equal Val1 Val2 fuzz) nil)
    
12.                   ((> Val1 Val2) t))))
    
13.   )
    
14. )
    
15. 
    
16. (defun Getinterpoints (ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)
    
17.   (setq e1 (entget ent1))
    
18.   (setq e2 (entget ent2))
    
19.   (setq pt1 (cdr (assoc 10 e1)))
    
20.   (setq pt2 (cdr (assoc 11 e1)))
    
21.   (setq pt3 (cdr (assoc 10 e2)))
    
22.   (setq pt4 (cdr (assoc 11 e2)))
    
23.   (inters pt1 pt2 pt3 pt4)
    
24. )
    
25. 
    
26. (defun GetAllInters (ss / n i j ent1 ent2 points point)
    
27.   (setq n (sslength ss))
    
28.   (setq        i 0
    
29.         j 0
    
30.   )
    
31.   (while (< i n)
    
32.     (setq j (1+ i))
    
33.     (setq ent1 (ssname ss i))
    
34.     (while (< j n)
    
35.       (setq ent2 (ssname ss j))
    
36.       (if (setq point (getinterpoints ent1 ent2))
    
37.         (setq points (append points (list point)))
    
38.       )
    
39.       (setq j (1+ j))
    
40.     )
    
41.     (setq i (1+ i))
    
42.   )
    
43.   points
    
44. )
    
45. 
    
46. (defun c:test (/ ss n i pts pt pt_next dist BlkName)
    
47.   (setq os (getvar "osmode"))
    
48.   (setq cmd (getvar "cmdecho"))
    
49.   (setq ss (ssget '((0 . "LINE"))))
    
50.   (command "_.undo" "be")
    
51.   (setvar "osmode" 0)
    
52.   (setvar "cmdecho" 0)
    
53.   (setq pts (GetAllInters ss))
    
54.   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (car e1) (car e2) "<" 0.00001))))
    
55.   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (cadr e1) (cadr e2) "<" 0.00001))))
    
56.   
    
57.   (princ "\n")  
    
58.   (princ pts)
    
59.   
    
60.   (setq n (length pts))
    
61.   (setq i 0)
    
62.   (while (< i (1- n))
    
63.     (setq pt (nth i pts))
    
64.     (setq pt_next (nth (1+ i) pts))
    
65.     (if        (equal (cadr pt) (cadr pt_next) 0.000000001)
    
66.       (progn
    
67.         (setq dist (distance pt pt_next))
    
68.         (cond
    
69.           ((equal dist 5 0.00000001) (setq BlkName "Len5"))
    
70.           ((equal dist 11 0.00000001) (setq BlkName "Len11"))
    
71.           (t (setq BlkName nil))
    
72.         )
    
73.         (if BlkName
    
74.           (command "_.insert"
    
75.                  BlkName
    
76.                  (list (/ (+ (car pt) (car pt_next)) 2)
    
77.                        (/ (+ (cadr pt) (cadr pt_next)) 2)
    
78.                  )
    
79.                  ""
    
80.                  ""
    
81.                  ""
    
82.         )
    
83.         )
    
84.       )
    
85.     )
    
86.     (setq i (1+ i))
    
87.   )  
    
88.   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (car e1) (car e2) "<" 0.00001))))
    
89.   
    
90.   (princ "\n")  
    
91.   (princ pts)
    
92.   
    
93.   (setq i 0)
    
94.   (while (< i (1- n))
    
95.     (setq pt (nth i pts))
    
96.     (setq pt_next (nth (1+ i) pts))
    
97.     (if        (equal (car pt) (car pt_next) 0.000000001)
    
98.       (progn
    
99.         (setq dist (distance pt pt_next))
    
100.         (cond
     
101.           ((equal dist 5 0.000000001) (setq BlkName "Len5"))
     
102.           ((equal dist 11 0.0000000001) (setq BlkName "Len11"))
     
103.           (t (setq BlkName nil))
     
104.         )
     
105.         (if BlkName
     
106.           (command "_.insert"
     
107.                  BlkName
     
108.                  (list (/ (+ (car pt) (car pt_next)) 2)
     
109.                        (/ (+ (cadr pt) (cadr pt_next)) 2)
     
110.                  )
     
111.                  ""
     
112.                  ""
     
113.                  "90"
     
114.         )
     
115.         )
     
116.       )
     
117.     )
     
118.     (setq i (1+ i))
     
119.   )
     
120.   (command "_.undo" "e")
     
121.   (setvar "osmode" os)
     
122.   (setvar "cmdecho" cmd)
     
123.   (princ)
     
124. )
     

<br /> <br /> (defun Wl-equal(Val1 Val2 fun fuzz)<br />   (cond<br />     ((= fun "=") (equal Val1 Val2 fuzz) t)<br />     ((= fun "<") (cond<br />                    ((equal Val1 Val2 fuzz) nil)<br />                    ((< Val1 Val2) t)))<br />     ((= fun ">" (cond<br />                   ((equal Val1 Val2 fuzz) nil)<br />                   ((> Val1 Val2) t))))<br />   )<br /> )<br /> <br /> (defun Getinterpoints (ent1 ent2 / e1 e2 pt1 pt2 pt3 pt4)<br />   (setq e1 (entget ent1))<br />   (setq e2 (entget ent2))<br />   (setq pt1 (cdr (assoc 10 e1)))<br />   (setq pt2 (cdr (assoc 11 e1)))<br />   (setq pt3 (cdr (assoc 10 e2)))<br />   (setq pt4 (cdr (assoc 11 e2)))<br />   (inters pt1 pt2 pt3 pt4)<br /> )<br /> <br /> (defun GetAllInters (ss / n i j ent1 ent2 points point)<br />   (setq n (sslength ss))<br />   (setq        i 0<br />         j 0<br />   )<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq ent1 (ssname ss i))<br />     (while (< j n)<br />       (setq ent2 (ssname ss j))<br />       (if (setq point (getinterpoints ent1 ent2))<br />         (setq points (append points (list point)))<br />       )<br />       (setq j (1+ j))<br />     )<br />     (setq i (1+ i))<br />   )<br />   points<br /> )<br /> <br /> (defun c:test (/ ss n i pts pt pt_next dist BlkName)<br />   (setq os (getvar "osmode"))<br />   (setq cmd (getvar "cmdecho"))<br />   (setq ss (ssget '((0 . "LINE"))))<br />   (command "_.undo" "be")<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setq pts (GetAllInters ss))<br />   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (car e1) (car e2) "<" 0.00001))))<br />   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (cadr e1) (cadr e2) "<" 0.00001))))<br />   <br />   (princ "\n")  <br />   (princ pts)<br />   <br />   (setq n (length pts))<br />   (setq i 0)<br />   (while (< i (1- n))<br />     (setq pt (nth i pts))<br />     (setq pt_next (nth (1+ i) pts))<br />     (if        (equal (cadr pt) (cadr pt_next) 0.000000001)<br />       (progn<br />         (setq dist (distance pt pt_next))<br />         (cond<br />           ((equal dist 5 0.00000001) (setq BlkName "Len5"))<br />           ((equal dist 11 0.00000001) (setq BlkName "Len11"))<br />           (t (setq BlkName nil))<br />         )<br />         (if BlkName<br />           (command "_.insert"<br />                  BlkName<br />                  (list (/ (+ (car pt) (car pt_next)) 2)<br />                        (/ (+ (cadr pt) (cadr pt_next)) 2)<br />                  )<br />                  ""<br />                  ""<br />                  ""<br />         )<br />         )<br />       )<br />     )<br />     (setq i (1+ i))<br />   )  <br />   (setq pts (vl-sort pts '(lambda (e1 e2) (wl-equal (car e1) (car e2) "<" 0.00001))))<br />   <br />   (princ "\n")  <br />   (princ pts)<br />   <br />   (setq i 0)<br />   (while (< i (1- n))<br />     (setq pt (nth i pts))<br />     (setq pt_next (nth (1+ i) pts))<br />     (if        (equal (car pt) (car pt_next) 0.000000001)<br />       (progn<br />         (setq dist (distance pt pt_next))<br />         (cond<br />           ((equal dist 5 0.000000001) (setq BlkName "Len5"))<br />           ((equal dist 11 0.0000000001) (setq BlkName "Len11"))<br />           (t (setq BlkName nil))<br />         )<br />         (if BlkName<br />           (command "_.insert"<br />                  BlkName<br />                  (list (/ (+ (car pt) (car pt_next)) 2)<br />                        (/ (+ (cadr pt) (cadr pt_next)) 2)<br />                  )<br />                  ""<br />                  ""<br />                  "90"<br />         )<br />         )<br />       )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (command "_.undo" "e")<br />   (setvar "osmode" os)<br />   (setvar "cmdecho" cmd)<br />   (princ)<br /> )<br />