autolisp如何实现自动插入块（利用直线）

q3_2006

275437962 发表于 2013-12-28 20:55
二是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问 ...

你提供块吧...不知道你的块什么情况...

q3_2006

代码删除...

q3_2006

直线长度\角度\虚拟圆半径,都由你自己输入...想多少是多少...

q3_2006

275437962 发表于 2013-12-28 20:55
二是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问 ...

图里面没有你要插块呀....或者说下块名称??

q3_2006

楼主人品太差...代码删除

275437962

275437962 发表于 2013-12-28 20:55
二是“让新插入块的图层和它对应的直线所在图层一致，并让所有插入块的颜色改成bylayer(即随层)”,这个问 ...

哪位朋友，把程序剩下的问题解决了，这个明经币都送给这个朋友！！！

q3_2006

275437962 发表于 2013-12-29 12:12
哪位朋友，把程序剩下的问题解决了，这个明经币都送给这个朋友！！！

没听说有谁缺这几个虚拟币的.....

275437962

q3_2006 发表于 2013-12-28 20:31
代码删除...

你的程序没有改好，还存在一些问题，结果你还要增加明经币，你觉得你这样子做如何，问题提了那么长时间，也不理视，难道你就为了那100个明经币吗，当然我尊重你的劳动成果！！！！

q3_2006

275437962 发表于 2013-12-29 13:50
你的程序没有改好，还存在一些问题，结果你还要增加明经币，你觉得你这样子做如何，问题提了那么长时间， ...

2. (defun c:tt ( / a ang bnm e en i la len n pe pm ps pts ss sse ssl)
   
3.         (vl-load-com)
   
4.         (vl-cmdf "undo" "be")
   
5.   (if (setq bnm (getstring "\输入块名:"))
   
6.   (progn
   
7.           (setq len (getdist "\n输入被替换直线的长度:"))
   
8.           (setq ang (getangle "\n输入被替换直线的角度:"))
   
9.           (setq r (getreal "\n输入虚拟圆的半径:"))
   
10.           (setq ss (ssget '((0 . "line"))))
    
11.    (setq i -1 ssl (ssadd))
    
12.    (while (setq en (ssname ss (setq i (1+ i))))
    
13.            (setq len1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Length )
    
14.                    ang1 (Vlax-Get (Vlax-Ename->Vla-Object en) 'Angle )
    
15.                               )
    
16.            (if (and (= len1 len) (= ang1 ang))
    
17.                    (ssadd en ssl)
    
18.                    )
    
19.            )
    
20.                    (setq n -1)
    
21.                    (while (setq e (ssname ssl (setq n (1+ n))))
    
22.                            (progn
    
23.                            (setq ps (Vlax-Get (Vlax-Ename->Vla-Object e) 'StartPoint )
    
24.                            pe (Vlax-Get (Vlax-Ename->Vla-Object e) 'EndPoint )
    
25.                            pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ ps pe))
    
26.                           la (Vlax-Get (Vlax-Ename->Vla-Object e) 'Layer )
    
27.                    )
    
28.                    (command "circle" pm r)
    
29.                    (setq a (entlast))
    
30.                    (setq pts (divpts a 500))
    
31.                    (setq sse (ssget "cp" pts))
    
32.                    (command "erase" a sse "")
    
33.                    (setvar "clayer" la)
    
34.                    (command "-insert" bnm pm "" "" "")
    
35.                    (vlax-for X
    
36.      (vla-item (vla-get-blocks
    
37.    (vla-get-activedocument (vlax-get-acad-object))
    
38.         )
    
39.         bnm
    
40.      )
    
41.     (setq el (cons (vlax-vla-object->ename X) el))
    
42.   )
    
43.   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
    
44.                   
    
45.                    )
    
46.                    )
    
47.            )
    
48.    )
    
49.    (command "_.regen")
    
50.    (vl-cmdf "undo" "e")
    
51. )
    
52. (defun divpts (ename n / ename endparam i nparam pt ptlst startparam)
    
53.   (setq startparam (vlax-curve-getstartparam ename)
    
54. endparam (vlax-curve-getendparam ename)
    
55. nparam (/ (- endparam startparam) n)
    
56. i -1
    
57. ptlst '()
    
58.   )
    
59.   (while (<= (setq i (1+ i))
    
60.       n
    
61.   )
    
62.     (setq pt (vlax-curve-getpointatparam ename (* i nparam))
    
63.    ptlst (cons pt ptlst)
    
64.     )
    
65.   )
    
66.   (reverse ptlst)
    
67. )
    
68. 
    

(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

最终处理图 代码已经补上,请用最终版