这个程序还有几个问题，大家帮忙解决一下！！！

275437962

我想让CAD中的所有满足固定长度和角度两个条件（如直线的长度为0.75，角度为0）的直线的中点插入事先命名的块，让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)，还有很重要的一点，并将距每一条满足条件直线中点的固定长度范围内（这个范围最好为以每一条直线中点为圆心的虚拟圆）的对象删除（删除的对像包括落在虚拟圆内的对像，也包括与虚拟圆相交的对象；包括每一条满足条件的直线）

说明：里面出现的长度 和角度以及虚拟圆的半径，最好可以更改。

上面是我最初提的问题，有一位朋友写了如下代码，但还存在如下三个问题：

一是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问题还是没有解决，现在程序是新插入块的图层是发生变化了，不是0层，但所有新插入的块的图层对应的应该是案例数据中黄色或紫色线（即满足上面两个条件的直线）所在的图层，现在新插入块的图层对应的是红色的线所在的图层(你可以用程序执行一下下面的“案例数据.dwg”)

二是，我测试时发现的，如果直线的长度不是整的，而是，比如0.75或是0.075，那么这时候直线是不能被选中插入块的

三是，还有就是那个角度条件 ，不起作用，如给成90度，根本就不能达到要求。

1. (defun c:tt ( / a ang bnm e en i la len pe pm ps pts ss sse ssl)
   
2.         (vl-load-com)
   
3.         (vl-cmdf "undo" "be")
   
4.   (if (and (setq bnm (getstring "\输入块名:"))
   
5.            (setq ss (ssget '((0 . "line")))))
   
6.   (progn
   
7.    (setq i -1 ssl (ssadd))
   
8.    (while (setq en (ssname ss (setq i (1+ i))))
   
9.            (setq len (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
   
10.                    ang (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
    
11.                    la (Vlax-Get (Vlax-Ename->Vla-Object en) 'Layer )
    
12.            )
    
13.            (if (and (= len 1.0) (= ang 0.0));线长,角度可改
    
14.                    (ssadd en ssl)
    
15.                    )
    
16.            )
    
17.                    (setq i -1)
    
18.                    (while (setq e (ssname ssl (setq i (1+ i))))
    
19.                            (progn
    
20.                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
    
21.                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
    
22.                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
    
23.                    )
    
24.                    (command "circle" pm 1.0);半径可改
    
25.                    (setq a (entlast))
    
26.                    (setq pts (divpts a 500))
    
27.                    (setq sse (ssget "cp" pts))
    
28.                    (command "erase" a sse "")
    
29.                    (command "-insert" bnm pm "0.5" "" "")
    
30.                    (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
    
31.                    )
    
32.                    )
    
33.            )
    
34.    )
    
35.    (vl-cmdf "undo" "e")
    
36. )
    
37. (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
    
38.   (setq startparam (vlax-curve-getstartparam ename)
    
39. endparam (vlax-curve-getendparam ename)
    
40. nparam (/ (- endparam startparam) n)
    
41. i -1
    
42. ptlst '()
    
43.   )
    
44.   (while (<= (setq i (1+ i))
    
45.       n
    
46.   )
    
47.     (setq pt (vlax-curve-getpointatparam ename (* i nparam))
    
48.    ptlst (cons pt ptlst)
    
49.     )
    
50.   )
    
51.   (reverse ptlst)
    
52. )
    

(defun c:tt ( / a ang bnm e en i la len pe pm ps pts ss sse ssl)<br />         (vl-load-com)<br />         (vl-cmdf "undo" "be")<br />   (if (and (setq bnm (getstring "\输入块名:"))<br />            (setq ss (ssget '((0 . "line"))))) <br />   (progn<br />    (setq i -1 ssl (ssadd))<br />    (while (setq en (ssname ss (setq i (1+ i))))<br />            (setq len (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )<br />                    ang (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )<br />                    la (Vlax-Get (Vlax-Ename->Vla-Object en) 'Layer )<br />            )<br />            (if (and (= len 1.0) (= ang 0.0));线长,角度可改<br />                    (ssadd en ssl)<br />                    )<br />            )<br />                    (setq i -1)<br />                    (while (setq e (ssname ssl (setq i (1+ i))))<br />                            (progn<br />                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )<br />                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )<br />                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))<br />                    )<br />                    (command "circle" pm 1.0);半径可改<br />                    (setq a (entlast))<br />                    (setq pts (divpts a 500))<br />                    (setq sse (ssget "cp" pts))<br />                    (command "erase" a sse "")<br />                    (command "-insert" bnm pm "0.5" "" "")<br />                    (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)<br />                    )<br />                    )<br />            )<br />    )<br />    (vl-cmdf "undo" "e")<br /> )<br /> (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)<br />   (setq startparam (vlax-curve-getstartparam ename)<br /> endparam (vlax-curve-getendparam ename)<br /> nparam (/ (- endparam startparam) n)<br /> i -1<br /> ptlst '()<br />   )<br />   (while (<= (setq i (1+ i))<br />       n<br />   )<br />     (setq pt (vlax-curve-getpointatparam ename (* i nparam))<br />    ptlst (cons pt ptlst)<br />     )<br />   )<br />   (reverse ptlst)<br /> )<br />

q3_2006

大家不要理会....问题已经解决,但此人人品巨差,没有支付100明经,最终代码完成代码我已经删除!

275437962

q3_2006 发表于 2013-12-29 13:25
大家不要理会....问题已经解决,但此人人品巨差,没有支付100明经,最终代码完成代码我已经删除!

兄弟，作人要厚道，本来就好100个明经币，结果问题还没解决完，就再要求增加100，还说我没有了，有的时候，人不能太在乎利了，在说，我也没有说不给啊，可以我后来说明了，这个程序还存在一些问题，你根本不理视，做事要有始有终吗，这样别人才会敬重啊！！1

q3_2006

275437962 发表于 2013-12-29 13:43
兄弟，作人要厚道，本来就好100个明经币，结果问题还没解决完，就再要求增加100，还说我没有了，有的时候 ...

最终版已经删除...我的演示已经说明问题..图层已经改成直线的层了...并且将图块颜色统一随层....你去准备好100明经币再来悬赏....不然不会有人再相信你的...我的人品,有目共睹!

275437962

q3_2006 发表于 2013-12-29 13:49
最终版已经删除...我的演示已经说明问题..图层已经改成直线的层了...并且将图块颜色统一随层....你去准备 ...

兄弟，咱们先不说人品的问题，你看看我上面的需求以及我后来测试程序发现的问题，你光拿你的演示说事，你说图层已经改成直线的层了，并且将图块颜色统一随层，你最好仔细看看我上面提的问题，“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)，”  
还有
“一是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问题还是没有解决，现在程序是新插入块的图层是发生变化了，不是0层，但所有新插入的块的图层对应的应该是案例数据中黄色或紫色线（即满足上面两个条件的直线）所在的图层，现在新插入块的图层对应的是红色的线所在的图层(你可以用程序执行一下下面的“案例数据.dwg”)”
不是和任意直线的图层一致，而是和满足条件直线的图层一致，也就是案例数据中黄色或紫色线的直线，不知道你有没有执行过上面的案例数据，你试了就知道了，执行完新插入的图层的颜色是红色


还有就是后面的两个测试的问题，你有没有试了，我确实发现存在这些问题，我才提出了，也不是我额外提出的，原来的需求里，写的都很清楚，（如直线的长度为0.75，角度为0），你的程序只认整数长度，还有既然允许改角度，那么我试个90度，结果程度不能找到这样的线，

我是就事论事，没有针对人，你上来就说人品不好，太不够意思了吗，当时没有即时给你这100明经币，想着程序还有些问题，而且确实影响使用，所以就暂时没给，唉，我希望这是个误会，不要往心里去！！！我确实是尊重别人劳动成果的，但我觉得拿出让大家都信服的代码更受人尊重！！！

q3_2006

• http://bbs.mjtd.com/thread-108828-1-1.html
  看下最终版...你到底开了几个帖子....也上了图片...处理后的...
  

275437962

抱歉抱歉抱歉抱歉

q3_2006

275437962 发表于 2013-12-29 14:49
兄弟，你正面回答，我的问题在上个页面是不是也是这样提的，没有额外增加吧，你敢保证你的程序没有我说明的 ...

2. ;;第一版,处理关键直线长度及角度相同的情况
   
3. (defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)
   
4.         (vl-load-com)
   
5.         (vl-cmdf "undo" "be")
   
6.   (if (setq bnm (getstring "\输入块名:"))
   
7.   (progn
   
8.           (setq len (getdist "\n输入被替换直线的长度:"))
   
9.           (setq ang (getangle "\n输入被替换直线的角度:"))
   
10.           (setq r (getreal "\n输入虚拟圆的半径:"))
    
11.           (setq ss (ssget '((0 . "line"))))
    
12.    (setq i -1 ssl (ssadd))
    
13.    (while (setq en (ssname ss (setq i (1+ i))))
    
14.            (setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
    
15.                    ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
    
16.                               )
    
17.            (if (and (= len1 len) (= ang1 ang))
    
18.                    (ssadd en ssl)
    
19.                    )
    
20.            )
    
21.                    (setq n -1)
    
22.                    (while (setq e (ssname ssl (setq n (1+ n))))
    
23.                            (progn
    
24.                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
    
25.                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
    
26.                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
    
27.                           la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )
    
28.                    )
    
29.                    (command "circle" pm r)
    
30.                    (setq a (entlast))
    
31.                    (setq pts (divpts a 500))
    
32.                    (setq sse (ssget "cp" pts))
    
33.                    (command "erase" a sse "")
    
34.                    (command "-insert" bnm pm "" "" "")
    
35.                    (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
    
36.                    (vlax-for X
    
37.      (vla-item (vla-get-blocks
    
38.    (vla-get-activedocument (vlax-get-acad-object))
    
39.         )
    
40.         bnm
    
41.      )
    
42.     (setq el (cons (vlax-vla-object->ename X) el))
    
43.   )
    
44.   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 256))el)
    
45.                   
    
46.                    )
    
47.                    )
    
48.            )
    
49.    )
    
50.    (command "_.regen")
    
51.    (vl-cmdf "undo" "e")
    
52. )
    
53. (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
    
54.   (setq startparam (vlax-curve-getstartparam ename)
    
55. endparam (vlax-curve-getendparam ename)
    
56. nparam (/ (- endparam startparam) n)
    
57. i -1
    
58. ptlst '()
    
59.   )
    
60.   (while (<= (setq i (1+ i))
    
61.       n
    
62.   )
    
63.     (setq pt (vlax-curve-getpointatparam ename (* i nparam))
    
64.    ptlst (cons pt ptlst)
    
65.     )
    
66.   )
    
67.   (reverse ptlst)
    
68. )
    
69. 
    
70. (defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)
    
71.         (vl-load-com)
    
72.         (vl-cmdf "undo" "be")
    
73.   (if (setq bnm (getstring "\输入块名:"))
    
74.   (progn
    
75.           (setq len (getdist "\n输入被替换直线的长度:"))
    
76.           (setq ang (getangle "\n输入被替换直线的角度:"))
    
77.           (setq r (getreal "\n输入虚拟圆的半径:"))
    
78.           (setq ss (ssget '((0 . "line"))))
    
79.    (setq i -1 ssl (ssadd))
    
80.    (while (setq en (ssname ss (setq i (1+ i))))
    
81.            (setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
    
82.                    ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
    
83.                               )
    
84.            (if (and (= len1 len) (= ang1 ang))
    
85.                    (ssadd en ssl)
    
86.                    )
    
87.            )
    
88.                    (setq n -1)
    
89.                    (while (setq e (ssname ssl (setq n (1+ n))))
    
90.                            (progn
    
91.                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
    
92.                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
    
93.                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
    
94.                           la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )
    
95.                    )
    
96.                    (command "circle" pm r)
    
97.                    (setq a (entlast))
    
98.                    (setq pts (divpts a 500))
    
99.                    (setq sse (ssget "cp" pts))
    
100.                    (command "erase" a sse "")
     
101.                    (setvar "clayer" la)
     
102.                    (command "-insert" bnm pm "" "" "")
     
103.                    (vlax-for X
     
104.      (vla-item (vla-get-blocks
     
105.    (vla-get-activedocument (vlax-get-acad-object))
     
106.         )
     
107.         bnm
     
108.      )
     
109.     (setq el (cons (vlax-vla-object->ename X) el))
     
110.   )
     
111.   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
     
112.                   
     
113.                    )
     
114.                    )
     
115.            )
     
116.    )
     
117.    (command "_.regen")
     
118.    (vl-cmdf "undo" "e")
     
119. )
     
120. (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
     
121.   (setq startparam (vlax-curve-getstartparam ename)
     
122. endparam (vlax-curve-getendparam ename)
     
123. nparam (/ (- endparam startparam) n)
     
124. i -1
     
125. ptlst '()
     
126.   )
     
127.   (while (<= (setq i (1+ i))
     
128.       n
     
129.   )
     
130.     (setq pt (vlax-curve-getpointatparam ename (* i nparam))
     
131.    ptlst (cons pt ptlst)
     
132.     )
     
133.   )
     
134.   (reverse ptlst)
     
135. )
     
136. 
     

;;第一版,处理关键直线长度及角度相同的情况<br /> (defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)<br />         (vl-load-com)<br />         (vl-cmdf "undo" "be")<br />   (if (setq bnm (getstring "\输入块名:"))<br />   (progn<br />           (setq len (getdist "\n输入被替换直线的长度:"))<br />           (setq ang (getangle "\n输入被替换直线的角度:"))<br />           (setq r (getreal "\n输入虚拟圆的半径:"))<br />           (setq ss (ssget '((0 . "line"))))<br />    (setq i -1 ssl (ssadd))<br />    (while (setq en (ssname ss (setq i (1+ i))))<br />            (setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )<br />                    ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )<br />                               )<br />            (if (and (= len1 len) (= ang1 ang))<br />                    (ssadd en ssl)<br />                    )<br />            )<br />                    (setq n -1)<br />                    (while (setq e (ssname ssl (setq n (1+ n))))<br />                            (progn<br />                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )<br />                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )<br />                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))<br />                           la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )<br />                    )<br />                    (command "circle" pm r)<br />                    (setq a (entlast))<br />                    (setq pts (divpts a 500))<br />                    (setq sse (ssget "cp" pts))<br />                    (command "erase" a sse "")<br />                    (command "-insert" bnm pm "" "" "")<br />                    (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)<br />                    (vlax-for X<br />      (vla-item (vla-get-blocks<br />    (vla-get-activedocument (vlax-get-acad-object))<br />         )<br />         bnm<br />      )<br />     (setq el (cons (vlax-vla-object->ename X) el))<br />   )<br />   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 256))el)<br />                    <br />                    )<br />                    )<br />            )<br />    )<br />    (command "_.regen")<br />    (vl-cmdf "undo" "e")<br /> )<br /> (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)<br />   (setq startparam (vlax-curve-getstartparam ename)<br /> endparam (vlax-curve-getendparam ename)<br /> nparam (/ (- endparam startparam) n)<br /> i -1<br /> ptlst '()<br />   )<br />   (while (<= (setq i (1+ i))<br />       n<br />   )<br />     (setq pt (vlax-curve-getpointatparam ename (* i nparam))<br />    ptlst (cons pt ptlst)<br />     )<br />   )<br />   (reverse ptlst)<br /> )<br /> <br /> (defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)<br />         (vl-load-com)<br />         (vl-cmdf "undo" "be")<br />   (if (setq bnm (getstring "\输入块名:"))<br />   (progn<br />           (setq len (getdist "\n输入被替换直线的长度:"))<br />           (setq ang (getangle "\n输入被替换直线的角度:"))<br />           (setq r (getreal "\n输入虚拟圆的半径:"))<br />           (setq ss (ssget '((0 . "line"))))<br />    (setq i -1 ssl (ssadd))<br />    (while (setq en (ssname ss (setq i (1+ i))))<br />            (setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )<br />                    ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )<br />                               )<br />            (if (and (= len1 len) (= ang1 ang))<br />                    (ssadd en ssl)<br />                    )<br />            )<br />                    (setq n -1)<br />                    (while (setq e (ssname ssl (setq n (1+ n))))<br />                            (progn<br />                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )<br />                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )<br />                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))<br />                           la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )<br />                    )<br />                    (command "circle" pm r)<br />                    (setq a (entlast))<br />                    (setq pts (divpts a 500))<br />                    (setq sse (ssget "cp" pts))<br />                    (command "erase" a sse "")<br />                    (setvar "clayer" la)<br />                    (command "-insert" bnm pm "" "" "")<br />                    (vlax-for X<br />      (vla-item (vla-get-blocks<br />    (vla-get-activedocument (vlax-get-acad-object))<br />         )<br />         bnm<br />      )<br />     (setq el (cons (vlax-vla-object->ename X) el))<br />   )<br />   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)<br />                    <br />                    )<br />                    )<br />            )<br />    )<br />    (command "_.regen")<br />    (vl-cmdf "undo" "e")<br /> )<br /> (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)<br />   (setq startparam (vlax-curve-getstartparam ename)<br /> endparam (vlax-curve-getendparam ename)<br /> nparam (/ (- endparam startparam) n)<br /> i -1<br /> ptlst '()<br />   )<br />   (while (<= (setq i (1+ i))<br />       n<br />   )<br />     (setq pt (vlax-curve-getpointatparam ename (* i nparam))<br />    ptlst (cons pt ptlst)<br />     )<br />   )<br />   (reverse ptlst)<br /> )<br /> <br />

q3_2006

处理完这个样子

q3_2006

我什么时候要你加过钱...帮你解决问题还扣屎盆子..你让谁还会再帮你...有人缺这几个虚拟币吗??