砸锅卖铁求个道路交叉口处理的源码~~~

77077

对,就是院长这个,没源码啊,求真源码~


发个自编道路断面符号标注的源码,为什么采用插入属性块的方式呢,主要是为了后面修改字高的时候,减少计算量~~~
块形式自定即可..

2. (defun c:xx (/ str h pt1 pt2 ang old old1)
   
3. (setq old1 (getvar "blipmode"))
   
4. (setvar "blipmode" 0)
   
5. (setq lay (getvar "clayer")
   
6.       old (getvar "osmode")
   
7.       )
   
8. (command "color" "bylayer")
   
9. (command "layer" "m" "DM-断面符号" "c" "1" "DM-断面符号" "")
   
10. (setq str (getstring "\n请输入断面符号<A>"))(if (= str nil) (setq str "A"))
    
11. (setq h (getreal "\n设置字高<3.0>"))(if (= h nil) (setq h 3.0))
    
12. (progn (while
    
13. (setq pt1 (getpoint "\n选择第一点:")
    
14.       pt2 (getpoint pt1 "\n选择另一点:")
    
15.       ang (angle pt1 pt2)
    
16.       )
    
17. (setvar "osmode" 0)
    
18. (command "-Insert" "断面符号A" pt1 h h (angtos ang) (strcase str))
    
19. (command "-Insert" "断面符号B" pt2 h h (angtos ang) (strcase str))
    
20. (setvar "osmode" old)
    
21. ))
    
22. (setvar "osmode" old)
    
23. (setvar "blipmode" old1)
    
24. (command "layer" "s" lay "")
    
25. )

(defun c:xx (/ str h pt1 pt2 ang old old1)<br /> (setq old1 (getvar "blipmode"))<br /> (setvar "blipmode" 0)<br /> (setq lay (getvar "clayer")<br />       old (getvar "osmode")<br />       )<br /> (command "color" "bylayer")<br /> (command "layer" "m" "DM-断面符号" "c" "1" "DM-断面符号" "")<br /> (setq str (getstring "\n请输入断面符号<A>"))(if (= str nil) (setq str "A"))<br /> (setq h (getreal "\n设置字高<3.0>"))(if (= h nil) (setq h 3.0))<br /> (progn (while<br /> (setq pt1 (getpoint "\n选择第一点:")<br />       pt2 (getpoint pt1 "\n选择另一点:")<br />       ang (angle pt1 pt2)<br />       )<br /> (setvar "osmode" 0)<br /> (command "-Insert" "断面符号A" pt1 h h (angtos ang) (strcase str))<br /> (command "-Insert" "断面符号B" pt2 h h (angtos ang) (strcase str))<br /> (setvar "osmode" old)<br /> ))<br /> (setvar "osmode" old)<br /> (setvar "blipmode" old1)<br /> (command "layer" "s" lay "")<br /> )

Bellahx

77077 发表于 2014-6-17 14:49
这个还真没有,有两个是#线剪切的方法1.交点打断,然后删除短线.方法2.将线打断交点之间的部分.
自己修改了 ...

楼主可以把有的这两个发上来么，作为参考用~

荒野孤行

看这里：http://bbs.mjtd.com/thread-168329-1-1.html，可以达到你的要求，如果是要倒角直接改下command后面的即可。

77077

荒野孤行 发表于 2015-6-7 21:01
看这里：http://bbs.mjtd.com/thread-168329-1-1.html，可以达到你的要求，如果是要倒角直接改下command后面 ...

你发出来这个和我求的程序，差别太大了~~~

wy92160410

请问楼主解决了吗

鱼与熊掌

命令TT 仅供试玩. 随手写的

鱼与熊掌

1. (defun c:tt(/ e1 new_ss p ss ss_pts ss1 ss2)
   
2.         (setq ss(ssget))
   
3.         (setq ss_pts(mapcar 'cadr(cdr(last(ssnamex ss)))))
   
4.         (setq ss1 (ssget "cp" ss_pts '((62 . 1))))
   
5.         (cx-break-with ss1 ss1 t)
   
6.         (cx-erase (ssget "wp" ss_pts))
   
7.         (setq new_ss (ssget "cp" ss_pts '((62 . 1))))
   
8.         (setq new_ss(cx-ss2en new_ss))
   
9.         (while new_ss
   
10.                 (setq e1 (car new_ss))
    
11.                 (setq new_ss(cdr new_ss))
    
12.                 (vl-some
    
13.                         '(lambda(x)
    
14.                                 (setq e2 x)
    
15.                                 (cx-get-ins e1 x)
    
16.                         )
    
17.                         new_ss
    
18.                 )
    
19.                 (setq new_ss (vl-remove e2 new_ss))
    
20.                 (command "CHAMFER" "d" 100 100)
    
21.                 (command "CHAMFER"  (list e1 (cx-get-9pt e1 5 )) (list e2 (cx-get-9pt e2 5 )))
    
22.         )
    
23.         ;<<
    
24.         (setq ss2 (ssget "cp" ss_pts '((62 . 5))))
    
25.         (cx-break-with ss2 ss2 t)
    
26.         (cx-erase (ssget "wp" ss_pts '((62 . 5))))
    
27.         (setq new_ss (ssget "cp" ss_pts '((62 . 5))))
    
28.         (setq new_ss(cx-ss2en new_ss))
    
29.         (while new_ss
    
30.                 (setq e1 (car new_ss))
    
31.                 (setq new_ss(cdr new_ss))
    
32.                 (setq p
    
33.                         (car
    
34.                                 (vl-some
    
35.                                         '(lambda(x)
    
36.                                                 (setq e2 x)
    
37.                                                 (cx-get-ins e1 x)
    
38.                                         )
    
39.                                         new_ss
    
40.                                 )
    
41.                         )
    
42.                 )
    
43.                 (setq new_ss (vl-remove e2 new_ss))
    
44.                 (command "FILLET" "r" 80)
    
45.                 (command "FILLET"  (list e1 (cx-get-9pt e1 5 )) (list e2 (cx-get-9pt e2 5 )))
    
46.         )
    
47. )

(defun c:tt(/ e1 new_ss p ss ss_pts ss1 ss2)<br />         (setq ss(ssget))<br />         (setq ss_pts(mapcar 'cadr(cdr(last(ssnamex ss)))))<br />         (setq ss1 (ssget "cp" ss_pts '((62 . 1))))<br />         (cx-break-with ss1 ss1 t)<br />         (cx-erase (ssget "wp" ss_pts))<br />         (setq new_ss (ssget "cp" ss_pts '((62 . 1))))<br />         (setq new_ss(cx-ss2en new_ss))<br />         (while new_ss<br />                 (setq e1 (car new_ss))<br />                 (setq new_ss(cdr new_ss))<br />                 (vl-some<br />                         '(lambda(x)<br />                                 (setq e2 x)<br />                                 (cx-get-ins e1 x)<br />                         )<br />                         new_ss<br />                 )<br />                 (setq new_ss (vl-remove e2 new_ss))<br />                 (command "CHAMFER" "d" 100 100)<br />                 (command "CHAMFER"  (list e1 (cx-get-9pt e1 5 )) (list e2 (cx-get-9pt e2 5 )))<br />         )<br />         ;<<<br />         (setq ss2 (ssget "cp" ss_pts '((62 . 5))))<br />         (cx-break-with ss2 ss2 t)<br />         (cx-erase (ssget "wp" ss_pts '((62 . 5))))<br />         (setq new_ss (ssget "cp" ss_pts '((62 . 5))))<br />         (setq new_ss(cx-ss2en new_ss))<br />         (while new_ss<br />                 (setq e1 (car new_ss))<br />                 (setq new_ss(cdr new_ss))<br />                 (setq p<br />                         (car<br />                                 (vl-some<br />                                         '(lambda(x)<br />                                                 (setq e2 x)<br />                                                 (cx-get-ins e1 x)<br />                                         )<br />                                         new_ss<br />                                 )<br />                         )<br />                 )<br />                 (setq new_ss (vl-remove e2 new_ss))<br />                 (command "FILLET" "r" 80)<br />                 (command "FILLET"  (list e1 (cx-get-9pt e1 5 )) (list e2 (cx-get-9pt e2 5 )))<br />         )<br /> )