求高手帮忙，批量生成中线

吴琦

小弟初学lisp，会只找出两条线中线的办法，求高手帮忙搞定批量生成程序，感激不尽。
以下是生成中线的部分代码和测试图

2. 
   
3. 
   
4. (defun c:tt()
   
5. (setq ssL (ssget '((0 . "LINE"))))
   
6. ;;下面取出两条线的坐标
   
7. ;;;此处加入判断是否选择了两根梁线
   
8. ;;;下面取得两条梁线的四个端点
   
9. (if (= (sslength SSL) 2)
   
10.      (progn
    
11. (setq pt1 (cdr (assoc 10 (entget (ssname ssL 0))))
    
12.        pt2 (cdr (assoc 11 (entget (ssname ssL 0))))
    
13.        pt3 (cdr (assoc 10 (entget (ssname ssL 1))))
    
14.        pt4 (cdr (assoc 11 (entget (ssname ssL 1))))
    
15.        ang1 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 0))) 180) pi)  ;;;直线1的角度
    
16.        ang2 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 1))) 180) pi)  ;;;直线2的角度
    
17. 
    
18. )
    
19.        )
    
20.   ;;;增加错误函数
    
21. );end if
    
22. ;;;m1,m2为两条直线中心线的两端点
    
23. (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))  
    
24. (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))
    
25.     (if (and
    
26.       (= (rtos (car m1) 2 4) (rtos (car m2) 2 4))
    
27.       (= (rtos (cadr m1) 2 4) (rtos (cadr m2) 2 4))
    
28.       (= (rtos (last m1) 2 4) (rtos (last m2) 2 4))
    
29.     )
    
30.     (progn
    
31.       (setq pt10 pt1)
    
32.       (setq pt1 pt2)
    
33.       (setq pt2 pt10)
    
34.       (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))
    
35.       (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))
    
36.       )  
    
37.     )
    
38.   )

<br /> <br /> (defun c:tt()<br /> (setq ssL (ssget '((0 . "LINE"))))<br /> ;;下面取出两条线的坐标<br /> ;;;此处加入判断是否选择了两根梁线<br /> ;;;下面取得两条梁线的四个端点<br /> (if (= (sslength SSL) 2)<br />      (progn<br /> (setq pt1 (cdr (assoc 10 (entget (ssname ssL 0))))<br />        pt2 (cdr (assoc 11 (entget (ssname ssL 0))))<br />        pt3 (cdr (assoc 10 (entget (ssname ssL 1))))<br />        pt4 (cdr (assoc 11 (entget (ssname ssL 1))))<br />        ang1 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 0))) 180) pi)  ;;;直线1的角度<br />        ang2 (/ (* (vla-get-angle(vlax-ename->vla-object(ssname ssL 1))) 180) pi)  ;;;直线2的角度<br /> <br /> )<br />        )<br />   ;;;增加错误函数<br /> );end if<br /> ;;;m1,m2为两条直线中心线的两端点<br /> (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))  <br /> (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))<br />     (if (and <br />       (= (rtos (car m1) 2 4) (rtos (car m2) 2 4))<br />       (= (rtos (cadr m1) 2 4) (rtos (cadr m2) 2 4))<br />       (= (rtos (last m1) 2 4) (rtos (last m2) 2 4))<br />     )<br />     (progn<br />       (setq pt10 pt1)<br />       (setq pt1 pt2)<br />       (setq pt2 pt10)<br />       (setq m1 (list (/ (+ (car pt1) (car pt3)) 2) (/ (+ (cadr pt1) (cadr pt3)) 2)))<br />       (setq m2 (list (/ (+ (car pt2) (car pt4)) 2) (/ (+ (cadr pt2) (cadr pt4)) 2)))<br />       )  <br />     )<br />   )

cable2004

蒹葭_Keirll

同求，为楼主顶一下

004

测试图太片面,最好是从工作底图上截下的,未说明规则,太笼统,不好办.

328302216

看帖就回，顶起来让高手出招  偷学  

848818376

中心线的好像就可以

革天明

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

SunSpring

可以换个思路,画出中心线,用双向偏移,得到平行线.这样可以多选.

004

1. (defun c:tt (/           2PI         3/4PI A     ANG   B         BANG  BEND  BST
   
2.              END   LST         MID   PI/2  SS           SSMID SSPT1 SSPT2 ST
   
3.             )
   
4.   ;;添加直线中心线   2013-01-09   
   
5.   (setvar "osmode" 0)
   
6.   (setq pi/2 (/ pi 2))
   
7.   (setq 2pi (* 2 pi))
   
8.   (setq 3/4pi (/ (* 3 pi) 4))
   
9.   (defun sjzl (e / ANG EL END ST TMP)
   
10.     (setq el (entget e))
    
11.     (setq st (cdr (assoc 10 el)))
    
12.     (setq st (list (car st) (cadr st)))
    
13.     (setq end (cdr (assoc 11 el)))
    
14.     (setq end (list (car end) (cadr end)))
    
15.     (setq ang (angle st end))
    
16.     (cond ((or (= ang 0) (= ang pi) (= ang 2pi))
    
17.            (progn (setq ang 0)
    
18.                   (if (> (car st) (car end))
    
19.                     (setq tmp st
    
20.                           st  end
    
21.                           end tmp
    
22.                     )
    
23.                   )
    
24.            )
    
25.           )
    
26.           ((or (= ang pi/2) (= ang 3/4pi))
    
27.            (progn (setq ang pi/2)
    
28.                   (if (> (cadr st) (cadr end))
    
29.                     (setq tmp st
    
30.                           st  end
    
31.                           end tmp
    
32.                     )
    
33.                   )
    
34.            )
    
35.           )
    
36.           ((> ang pi)
    
37.            (progn (setq        ang (- ang pi)
    
38.                         tmp st
    
39.                         st  end
    
40.                         end tmp
    
41.                   )
    
42.            )
    
43.           )
    
44.     )
    
45.     (list st end ang)
    
46.   )
    
47.   (setq ss (ssget "x" '((0 . "LINE") (8 . "BEAM"))))
    
48.   (while (> (sslength ss) 0)
    
49.     (setq a (ssname ss 0))
    
50.     (setq lst (sjzl a))
    
51.     (setq st (car lst))
    
52.     (setq end (cadr lst))
    
53.     (setq ang (caddr lst))
    
54.     (setq mid (mapcar (function (lambda (a b) (/ (+ a b) 2))) st end))
    
55.     (setq sspt1 (polar mid (+ ang (/ pi 2)) 400)) ;选取长度
    
56.     (setq sspt2 (polar mid (- ang (/ pi 2)) 400))
    
57. ;;;    (command "pline" sspt1 sspt2 "")
    
58.     (command ".zoom" "w" sspt1 sspt2)
    
59.     (setq ssmid
    
60.            (ssget "f" (list sspt1 sspt2) '((0 . "LINE") (8 . "BEAM")))
    
61.     )
    
62.     (if        (= (sslength ssmid) 2)
    
63.       (progn
    
64.         (ssdel a ssmid)
    
65.         (ssdel a ss)
    
66.         (setq b (ssname ssmid 0))
    
67.         (setq lst (sjzl b))
    
68.         (setq bst (car lst))
    
69.         (setq bend (cadr lst))
    
70.         (setq bang (caddr lst))
    
71.         (if (equal ang bang 0.01)
    
72.           (progn
    
73.             (ssdel b ss)
    
74.             (setq st
    
75.                    (mapcar (function (lambda (a b) (/ (+ a b) 2))) st bst)
    
76.             )
    
77.             (setq end (mapcar (function (lambda (a b) (/ (+ a b) 2)))
    
78.                               end
    
79.                               bend
    
80.                       )
    
81.             )
    
82.             (entmake (list '(0 . "LINE") (cons 10 st) (cons 11 end)))
    
83.           )
    
84.         )
    
85.       )
    
86.       (ssdel a ss)
    
87.     )
    
88.   )
    
89.   (princ)
    
90. )
    

(defun c:tt (/           2PI         3/4PI A     ANG   B         BANG  BEND  BST<br />              END   LST         MID   PI/2  SS           SSMID SSPT1 SSPT2 ST<br />             )<br />   ;;添加直线中心线   2013-01-09   <br />   (setvar "osmode" 0)<br />   (setq pi/2 (/ pi 2))<br />   (setq 2pi (* 2 pi))<br />   (setq 3/4pi (/ (* 3 pi) 4))<br />   (defun sjzl (e / ANG EL END ST TMP)<br />     (setq el (entget e))<br />     (setq st (cdr (assoc 10 el)))<br />     (setq st (list (car st) (cadr st)))<br />     (setq end (cdr (assoc 11 el)))<br />     (setq end (list (car end) (cadr end)))<br />     (setq ang (angle st end))<br />     (cond ((or (= ang 0) (= ang pi) (= ang 2pi))<br />            (progn (setq ang 0)<br />                   (if (> (car st) (car end))<br />                     (setq tmp st<br />                           st  end<br />                           end tmp<br />                     )<br />                   )<br />            )<br />           )<br />           ((or (= ang pi/2) (= ang 3/4pi))<br />            (progn (setq ang pi/2)<br />                   (if (> (cadr st) (cadr end))<br />                     (setq tmp st<br />                           st  end<br />                           end tmp<br />                     )<br />                   )<br />            )<br />           )<br />           ((> ang pi)<br />            (progn (setq        ang (- ang pi)<br />                         tmp st<br />                         st  end<br />                         end tmp<br />                   )<br />            )<br />           )<br />     )<br />     (list st end ang)<br />   )<br />   (setq ss (ssget "x" '((0 . "LINE") (8 . "BEAM"))))<br />   (while (> (sslength ss) 0)<br />     (setq a (ssname ss 0))<br />     (setq lst (sjzl a))<br />     (setq st (car lst))<br />     (setq end (cadr lst))<br />     (setq ang (caddr lst))<br />     (setq mid (mapcar (function (lambda (a b) (/ (+ a b) 2))) st end))<br />     (setq sspt1 (polar mid (+ ang (/ pi 2)) 400)) ;选取长度<br />     (setq sspt2 (polar mid (- ang (/ pi 2)) 400))<br /> ;;;    (command "pline" sspt1 sspt2 "")<br />     (command ".zoom" "w" sspt1 sspt2)<br />     (setq ssmid<br />            (ssget "f" (list sspt1 sspt2) '((0 . "LINE") (8 . "BEAM")))<br />     )<br />     (if        (= (sslength ssmid) 2)<br />       (progn<br />         (ssdel a ssmid)<br />         (ssdel a ss)<br />         (setq b (ssname ssmid 0))<br />         (setq lst (sjzl b))<br />         (setq bst (car lst))<br />         (setq bend (cadr lst))<br />         (setq bang (caddr lst))<br />         (if (equal ang bang 0.01)<br />           (progn<br />             (ssdel b ss)<br />             (setq st<br />                    (mapcar (function (lambda (a b) (/ (+ a b) 2))) st bst)<br />             )<br />             (setq end (mapcar (function (lambda (a b) (/ (+ a b) 2)))<br />                               end<br />                               bend<br />                       )<br />             )<br />             (entmake (list '(0 . "LINE") (cons 10 st) (cons 11 end)))<br />           )<br />         )<br />       )<br />       (ssdel a ss)<br />     )<br />   )<br />   (princ)<br /> )<br />

004