哪位大神知道怎么把一条多义线各段的x、y方向的增量读出来的lisp程序吗

ll_j

wowan1314 发表于 2013-6-8 16:33
X变为绝对值，y不变 。 不知道对不对？！ 你看看
(mapcar '(lambda(x) (list (abs (car x)) (cadr x) (cad ...

轻多义线没有caddr。^_^

wowan1314

ll_j 发表于 2013-6-8 16:44
轻多义线没有caddr。^_^

呵呵！ 还是按您的代码妥当
(mapcar '(lambda(x) (cons (abs (car x)) (cdr x))) lst)

kxdm1984

是这样的，这个cad图中多段线起点在右边终点在左边，用以下代码得到x、y方向增量是这样的:((-169.046 279.382) (-334.067 -68.3381) (-251.557 -150.746) (-285.769 66.3281) (-90.5605 -124.617))，现在我希望不管多段线起点在那边，都希望x方向增量是正值，该如何修改代码，代码如下：
(
(lambda (l)
   (mapcar
     (function
       (lambda
         (a b)
          (mapcar '- b a)
       )
     )
     l
     (cdr l)
   )
)
  (mapcar
    'cdr
    (vl-remove-if-not
      (function
        (lambda (x) (= 10 (car x)))
      )
      (entget (car (entsel "\n选择多段线:")))
    )
  )
)

ZZXXQQ

2. ;输出长度到文件 明经 ZZXXQQ 2013.6.9
   
3. (defun c:tt ()
   
4. (setq nm (if (= (type nm) 'STR) nm ""))
   
5. (if (and (setq nm (getfiled "选择保存文件名" nm "txt" 1))
   
6.              (setq ss (ssget '((0 . "LWPOLYLINE"))))) (progn
   
7.   (setq i -1)
   
8.   (repeat (sslength ss)
   
9.    (setq ent (entget(ssname ss (setq i (1+ i)))))
   
10.    (setq plst (list))
    
11.    (foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
    
12.    (setq plst (reverse plst))
    
13.    (setq llst (mapcar
    
14.      '(lambda (a b) (list (abs(- (car b) (car a))) (- (cadr b) (cadr a))))
    
15.      plst (cdr plst)
    
16.     )
    
17.    )
    
18.    (setq fp (open nm (if (findfile nm) "a" "w")))
    
19.    (mapcar
    
20.    '(lambda (x)
    
21.    (princ "X=" fp) (princ (rtos (car x) 2 3) fp)
    
22.    (princ "Y=" fp) (princ (rtos (cadr x) 2 3) fp) (princ "\n" fp)
    
23.    )
    
24.    llst
    
25.   )
    
26.   (princ "\n" fp)
    
27.   (close fp)
    
28. )
    
29. ))
    
30. (princ)
    
31. )
    

;输出长度到文件 明经 ZZXXQQ 2013.6.9<br /> (defun c:tt ()<br /> (setq nm (if (= (type nm) 'STR) nm ""))<br /> (if (and (setq nm (getfiled "选择保存文件名" nm "txt" 1))<br />              (setq ss (ssget '((0 . "LWPOLYLINE"))))) (progn<br />   (setq i -1)<br />   (repeat (sslength ss)<br />    (setq ent (entget(ssname ss (setq i (1+ i)))))<br />    (setq plst (list))<br />    (foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))<br />    (setq plst (reverse plst))<br />    (setq llst (mapcar<br />      '(lambda (a b) (list (abs(- (car b) (car a))) (- (cadr b) (cadr a))))<br />      plst (cdr plst)<br />     )<br />    )<br />    (setq fp (open nm (if (findfile nm) "a" "w")))<br />    (mapcar<br />    '(lambda (x)<br />    (princ "X=" fp) (princ (rtos (car x) 2 3) fp)<br />    (princ "Y=" fp) (princ (rtos (cadr x) 2 3) fp) (princ "\n" fp)<br />    )<br />    llst<br />   )<br />   (princ "\n" fp)<br />   (close fp)<br /> )<br /> ))<br /> (princ)<br /> )<br />

kxdm1984

谢谢大神了

ll_j

kxdm1984 发表于 2013-6-9 00:05
是这样的，这个cad图中多段线起点在右边终点在左边，用以下代码得到x、y方向增量是这样的:((-169.046 279.3 ...

还按G版的代码延续下去：

1. (setq lst
   
2.        ((lambda (l)
   
3.           (mapcar
   
4.             (function
   
5.               (lambda
   
6.                 (a b)
   
7.                  (mapcar '- b a)
   
8.               )
   
9.             )
   
10.             l
    
11.             (cdr l)
    
12.           )
    
13.         )
    
14.          (if (< (caar (setq lst (mapcar
    
15.                                   'cdr
    
16.                                   (vl-remove-if-not
    
17.                                     (function
    
18.                                       (lambda (x) (= 10 (car x)))
    
19.                                     )
    
20.                                     (entget (car (entsel "\n选择多段线:")))
    
21.                                   )
    
22.                                 )
    
23.                       )
    
24.                 )
    
25.                 (caar (reverse lst))
    
26.              )
    
27.            lst
    
28.            (reverse lst)
    
29.          )
    
30.        )
    
31. )

(setq lst<br />        ((lambda (l)<br />           (mapcar<br />             (function<br />               (lambda<br />                 (a b)<br />                  (mapcar '- b a)<br />               )<br />             )<br />             l<br />             (cdr l)<br />           )<br />         )<br />          (if (< (caar (setq lst (mapcar<br />                                   'cdr<br />                                   (vl-remove-if-not<br />                                     (function<br />                                       (lambda (x) (= 10 (car x)))<br />                                     )<br />                                     (entget (car (entsel "\n选择多段线:")))<br />                                   )<br />                                 )<br />                       )<br />                 )<br />                 (caar (reverse lst))<br />              )<br />            lst<br />            (reverse lst)<br />          )<br />        )<br /> )

通俗一点应该是这样：

1. (defun c:tt ()
   
2.   (defun tmp (l)
   
3.     (mapcar
   
4.       (function
   
5.         (lambda
   
6.           (a b)
   
7.            (mapcar '- b a)
   
8.         )
   
9.       )
   
10.       l
    
11.       (cdr l)
    
12.     )
    
13.   )
    
14. 
    
15.   (setq lst (mapcar
    
16.               'cdr
    
17.               (vl-remove-if-not
    
18.                 (function
    
19.                   (lambda (x) (= 10 (car x)))
    
20.                 )
    
21.                 (entget (car (entsel "\n选择多段线:")))
    
22.               )
    
23.             )
    
24.   )
    
25.   (if (> (caar lst) (caar (reverse lst)))
    
26.     (setq lst (reverse lst))
    
27.   )
    
28.   (setq lst (tmp lst))
    
29. )

(defun c:tt ()<br />   (defun tmp (l)<br />     (mapcar<br />       (function<br />         (lambda<br />           (a b)<br />            (mapcar '- b a)<br />         )<br />       )<br />       l<br />       (cdr l)<br />     )<br />   )<br /> <br />   (setq lst (mapcar<br />               'cdr<br />               (vl-remove-if-not<br />                 (function<br />                   (lambda (x) (= 10 (car x)))<br />                 )<br />                 (entget (car (entsel "\n选择多段线:")))<br />               )<br />             )<br />   )<br />   (if (> (caar lst) (caar (reverse lst)))<br />     (setq lst (reverse lst))<br />   )<br />   (setq lst (tmp lst))<br /> )

kxdm1984

x方向增量为正值的问题是解决了，但是多段线起点如果在右边终点在左边的话，输出的值就刚好是反的

ll_j

kxdm1984 发表于 2013-6-9 11:08
x方向增量为正值的问题是解决了，但是多段线起点如果在右边终点在左边的话，输出的值就刚好是反的

那么你看看晓东那边的回帖。

kxdm1984

ZZXXQQ 发表于 2013-6-9 08:34

谢谢问题解决了。但如果我现在要输出一段多段线x、y方向增量，得到结果如下X=468.666Y=-190.668X=327.632Y=249.168X=436.12Y=-26.0002X=303.765Y=121.334; 现在我希望输出小数位保留三位，请问该如何设置

ZZXXQQ

kxdm1984 发表于 2013-6-9 12:20
谢谢问题解决了。但如果我现在要输出一段多段线x、y方向增量，得到结果如下X=468.666Y=-190.668X=327.632 ...

14楼改了。是要求所有数据写在一行吗？