求画直线相交断己

weiqi

同一图层  只有 line  线性求可以 输入打断距离  

画 line线时 遇到 同图层line线时 打断自己

请高手指教，求相应教程

qq25469005

xyp1964 发表于 2012-12-8 06:59

这个可以发下给我吗，很需要

edsion24

老大能不能做个多段线同样功能的。

Gu_xl

1. (defun c:tt (/ LA P0 PT S PL A)
   
2.   (setq la (getvar 'clayer))
   
3.   (setq p0 (getpoint "\n第一点:"))
   
4.   (while (setq pt (getpoint p0 "\n下一点:"))
   
5.     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
   
6.     (if        s
   
7.       
   
8.       (progn
   
9.         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
   
10.         (setq a p0)
    
11.         (foreach b pl
    
12.           (entmake
    
13.             (list '(0 . "line")
    
14.                   (cons 10 a)
    
15.                   (cons 11 b)
    
16.             )
    
17.           )
    
18.           (setq a b)
    
19.         )
    
20.         (entmake
    
21.           (list        '(0 . "line")
    
22.                 (cons 10 a)
    
23.                 (cons 11 pt)
    
24.           )
    
25.         )
    
26.       )
    
27.       (entmake
    
28.         (list '(0 . "line")
    
29.               (cons 10 p0)
    
30.               (cons 11 pt)
    
31.         )
    
32.       )
    
33.     )
    
34.     (setq p0 pt)
    
35.   )
    
36.   (princ)
    
37. )

(defun c:tt (/ LA P0 PT S PL A)<br />   (setq la (getvar 'clayer))<br />   (setq p0 (getpoint "\n第一点:"))<br />   (while (setq pt (getpoint p0 "\n下一点:"))<br />     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))<br />     (if        s<br />       <br />       (progn<br />         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))<br />         (setq a p0)<br />         (foreach b pl<br />           (entmake<br />             (list '(0 . "line")<br />                   (cons 10 a)<br />                   (cons 11 b)<br />             )<br />           )<br />           (setq a b)<br />         )<br />         (entmake<br />           (list        '(0 . "line")<br />                 (cons 10 a)<br />                 (cons 11 pt)<br />           )<br />         )<br />       )<br />       (entmake<br />         (list '(0 . "line")<br />               (cons 10 p0)<br />               (cons 11 pt)<br />         )<br />       )<br />     )<br />     (setq p0 pt)<br />   )<br />   (princ)<br /> )

Gu_xl

Gu_xl 发表于 2012-12-7 21:52

输入距离打断，更简单！自己思考吧！

weiqi

1. (defun c:tt (/ LA P0 PT S PL A)
   
2. (setq numdd (getint "请输入打断距离:"))
   
3.   (setq numdd (/ numdd 2))
   
4.   (setq la (getvar 'clayer))
   
5.   (setq p0 (getpoint "\n第一点:"))
   
6.   (while (setq pt (getpoint p0 "\n下一点:"))
   
7.     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
   
8.     (if        s
   
9. 
   
10.       (progn
    
11.         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
    
12.         (setq a p0)
    
13.                 (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))
    
14.                 (print jd)
    
15.                
    
16.                
    
17.                
    
18.         (foreach b pl
    
19.        
    
20.                
    
21.           (entmake
    
22.             (list '(0 . "line")
    
23.                   (cons 10 a)
    
24.                   (cons 11 b)
    
25.             )
    
26.           )
    
27.           (setq a b)
    
28.         )
    
29.                         (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) )
    
30.         (entmake
    
31.           (list        '(0 . "line")
    
32.                 (cons 10 zd2)
    
33.                 (cons 11 pt)
    
34.           )
    
35.         )
    
36.       )
    
37.       (entmake
    
38.         (list '(0 . "line")
    
39.               (cons 10 p0)
    
40.               (cons 11 pt)
    
41.         )
    
42.       )
    
43.     )
    
44.     (setq p0 pt)
    
45.   )
    
46.   (princ)
    
47. )

(defun c:tt (/ LA P0 PT S PL A)<br /> (setq numdd (getint "请输入打断距离:"))<br />   (setq numdd (/ numdd 2))<br />   (setq la (getvar 'clayer))<br />   (setq p0 (getpoint "\n第一点:"))<br />   (while (setq pt (getpoint p0 "\n下一点:"))<br />     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))<br />     (if        s<br /> <br />       (progn<br />         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))<br />         (setq a p0)<br />                 (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))<br />                 (print jd)<br />                 <br />                 <br />                 <br />         (foreach b pl<br />         <br />                 <br />           (entmake<br />             (list '(0 . "line")<br />                   (cons 10 a)<br />                   (cons 11 b)<br />             )<br />           )<br />           (setq a b)<br />         )<br />                         (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) )<br />         (entmake<br />           (list        '(0 . "line")<br />                 (cons 10 zd2)<br />                 (cons 11 pt)<br />           )<br />         )<br />       )<br />       (entmake<br />         (list '(0 . "line")<br />               (cons 10 p0)<br />               (cons 11 pt)<br />         )<br />       )<br />     )<br />     (setq p0 pt)<br />   )<br />   (princ)<br /> )

暂时做会做 打断一边的。这切做得不好。
不懂的地方很多。（cons 0 "line") (cons 8 la)
是什么意思？ (list '(0 . "line")
              (cons 10 p0)
              (cons 11 pt)
        )
查了下 cons是AutoLISP的基本表构造函数。
实例
    (cons 'a' (b c d))    ; ; ; 返回（A B C D）

请问 看什么开发手册呢

weiqi

双边的话 交点处 会多出 一条线且多个交点的时候，只断了 最后一个的距离。

1. (defun c:tt (/ LA P0 PT S PL A)
   
2. (setq numdd (getint "请输入打断距离:"))
   
3.   (setq numdd (/ numdd 2))
   
4.   (setq la (getvar 'clayer))
   
5.   (setq p0 (getpoint "\n第一点:"))
   
6.   (while (setq pt (getpoint p0 "\n下一点:"))
   
7.     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
   
8.     (if        s
   
9. 
   
10.       (progn
    
11.         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
    
12.         (setq a p0)
    
13.                 (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))
    
14.                 (print jd)
    
15.                
    
16.                
    
17.                
    
18.         (foreach b pl
    
19.          (setq zd1 (list (- (car b) (* (cos jd) numdd)) (- (cadr b) (* (sin jd) numdd)) (caddr b)) );;中点第一点
    
20.                
    
21.           (entmake
    
22.             (list '(0 . "line")
    
23.                   (cons 10 a)
    
24.                   (cons 11 zd1)
    
25.             )
    
26.           )
    
27.           (setq a b)
    
28.         )
    
29.           (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) );;中点第二点
    
30.         (entmake
    
31.           (list        '(0 . "line")
    
32.                 (cons 10 zd2)
    
33.                 (cons 11 pt)
    
34.           )
    
35.         )
    
36.       )
    
37.       (entmake
    
38.         (list '(0 . "line")
    
39.               (cons 10 p0)
    
40.               (cons 11 pt)
    
41.         )
    
42.       )
    
43.     )
    
44.     (setq p0 pt)
    
45.   )
    
46.   (princ)
    
47. )
    
48. 
    

(defun c:tt (/ LA P0 PT S PL A)<br /> (setq numdd (getint "请输入打断距离:"))<br />   (setq numdd (/ numdd 2))<br />   (setq la (getvar 'clayer))<br />   (setq p0 (getpoint "\n第一点:"))<br />   (while (setq pt (getpoint p0 "\n下一点:"))<br />     (setq s (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))<br />     (if        s<br /> <br />       (progn<br />         (setq pl (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))<br />         (setq a p0)<br />                 (setq jd (angle (list (car p0) (cadr p0)) (list (car pt) (cadr pt)) ))<br />                 (print jd)<br />                 <br />                 <br />                 <br />         (foreach b pl<br />          (setq zd1 (list (- (car b) (* (cos jd) numdd)) (- (cadr b) (* (sin jd) numdd)) (caddr b)) );;中点第一点<br />                 <br />           (entmake<br />             (list '(0 . "line")<br />                   (cons 10 a)<br />                   (cons 11 zd1)<br />             )<br />           )<br />           (setq a b)<br />         )<br />           (setq zd2 (list (+ (car a) (* (cos jd) numdd)) (+ (cadr a) (* (sin jd) numdd)) (caddr a)) );;中点第二点 <br />         (entmake<br />           (list        '(0 . "line")<br />                 (cons 10 zd2)<br />                 (cons 11 pt)<br />           )<br />         )<br />       )<br />       (entmake<br />         (list '(0 . "line")<br />               (cons 10 p0)<br />               (cons 11 pt)<br />         )<br />       )<br />     )<br />     (setq p0 pt)<br />   )<br />   (princ)<br /> )<br /> <br />

weiqi

我基础 太差了，望高手指点指点。

xyp1964

Gu_xl

Gu_xl 发表于 2012-12-7 21:52

1. (defun c:tt  (/ LA P0 PT S PL A d)
   
2.   (setq d (getdist "\n打断距离<0>:"))
   
3.   (if (null d)
   
4.     (setq d 0))
   
5.   (setq d (* 0.5 d))
   
6.   (setq la (getvar 'clayer))
   
7.   (setq p0 (getpoint "\n第一点:"))
   
8.   (while (setq pt (getpoint p0 "\n下一点:"))
   
9.     (setq s
   
10.            (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))
    
11.     (if        s
    
12. 
    
13.       (progn
    
14.         (setq pl
    
15.                (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))
    
16.         (setq a p0)
    
17.         (foreach b  pl
    
18.           (if (not (equal p0 b (* 0.1 d)))
    
19.             (progn
    
20.               (entmake
    
21.                 (list '(0 . "line")
    
22.                       (cons 10 a)
    
23.                       (cons 11 (polar b (angle pt p0) d))
    
24.                       )
    
25.                 )
    
26.               (setq a (polar b (angle p0 pt) d))
    
27.               )
    
28.             )
    
29.           )
    
30.         (entmake
    
31.           (list        '(0 . "line")
    
32.                 (cons 10 a)
    
33.                 (cons 11 pt)
    
34.                 )
    
35.           )
    
36.         )
    
37.       (entmake
    
38.         (list '(0 . "line")
    
39.               (cons 10 p0)
    
40.               (cons 11 pt)
    
41.               )
    
42.         )
    
43.       )
    
44.     (setq p0 pt)
    
45.     )
    
46.   (princ)
    
47.   )
    

(defun c:tt  (/ LA P0 PT S PL A d)<br />   (setq d (getdist "\n打断距离<0>:"))<br />   (if (null d)<br />     (setq d 0))<br />   (setq d (* 0.5 d))<br />   (setq la (getvar 'clayer))<br />   (setq p0 (getpoint "\n第一点:"))<br />   (while (setq pt (getpoint p0 "\n下一点:"))<br />     (setq s<br />            (ssget "f" (list p0 pt) (list (cons 0 "line") (cons 8 la))))<br />     (if        s<br /> <br />       (progn<br />         (setq pl<br />                (mapcar '(lambda (x) (cadr (cadddr x))) (ssnamex s)))<br />         (setq a p0)<br />         (foreach b  pl<br />           (if (not (equal p0 b (* 0.1 d)))<br />             (progn<br />               (entmake<br />                 (list '(0 . "line")<br />                       (cons 10 a)<br />                       (cons 11 (polar b (angle pt p0) d))<br />                       )<br />                 )<br />               (setq a (polar b (angle p0 pt) d))<br />               )<br />             )<br />           )<br />         (entmake<br />           (list        '(0 . "line")<br />                 (cons 10 a)<br />                 (cons 11 pt)<br />                 )<br />           )<br />         )<br />       (entmake<br />         (list '(0 . "line")<br />               (cons 10 p0)<br />               (cons 11 pt)<br />               )<br />         )<br />       )<br />     (setq p0 pt)<br />     )<br />   (princ)<br />   )<br />

start4444

很好的命令  收藏了先

香田里浪人

下载下来，以备需要时使用。