[LISP程序]：两个函数。

eachy

2. 
   
3. (defun 3dPoint->2dPoint  (3dpt)
   
4.         (list  (float (car 3dpt))  (float (cadr 3dpt)))
   
5. )
   
6. ;; '(0 1) (1 1) (2 2) ...) ----> '(0 1 1 1 2 2 ...)
   
7. (defun mlist->slist (lst / tmplst)
   
8.   (setq        lst    (reverse (mapcar '3dPoint->2dPoint lst)))
   
9.   (foreach n lst
   
10.     (setq tmplst (append (cdr n) tmplst)
    
11.           tmplst (append (list (car n)) tmplst)
    
12.     )
    
13.   )
    
14.   tmplst
    
15. )

<br /> (defun 3dPoint->2dPoint  (3dpt)<br />         (list  (float (car 3dpt))  (float (cadr 3dpt)))<br /> )<br /> ;; '(0 1) (1 1) (2 2) ...) ----> '(0 1 1 1 2 2 ...)<br /> (defun mlist->slist (lst / tmplst)<br />   (setq        lst    (reverse (mapcar '3dPoint->2dPoint lst)))<br />   (foreach n lst<br />     (setq tmplst (append (cdr n) tmplst)<br />           tmplst (append (list (car n)) tmplst)<br />     )<br />   )<br />   tmplst<br /> )

Qlin

用你的第一个函数写了个小程序，
我叫它2维移动和2维拷贝，做三维
建模的时候挺方便：

2. 
   
3. (defun c:m2d ()
   
4.   (2dshift "move")
   
5.   (princ)
   
6. )
   
7. (defun c:c2d ()
   
8.   (2dshift "copy")
   
9.   (princ)
   
10. )
    
11. (defun 2dshift (str_in / ss1 pt1 pt2 os cmd)
    
12.   (setq ss1 (ssget))
    
13.   (if ss1 (setq pt1 (getpoint "\nSpecify base point: ")))
    
14.   (if pt1 (setq pt2 (getpoint pt1 "\nSpecify second point: ")))
    
15.   (if pt2
    
16.     (progn
    
17.       (setq pt1 (3dPoint->2dPoint pt1)
    
18.             pt2 (3dPoint->2dPoint pt2))
    
19.       (setq os (getvar "osmode")
    
20.             cmd (getvar "cmdecho"))
    
21.       (setvar "osmode" 0)
    
22.       (setvar "cmdecho" 0)
    
23.       (command str_in ss1 "" pt1 pt2)
    
24.       (setvar "osmode" os)
    
25.       (setvar "cmdecho" cmd)
    
26.     );progn
    
27.   );if
    
28. );end
    
29. 
    

<br /> (defun c:m2d ()<br />   (2dshift "move")<br />   (princ)<br /> )<br /> (defun c:c2d ()<br />   (2dshift "copy")<br />   (princ)<br /> )<br /> (defun 2dshift (str_in / ss1 pt1 pt2 os cmd)<br />   (setq ss1 (ssget))<br />   (if ss1 (setq pt1 (getpoint "\nSpecify base point: ")))<br />   (if pt1 (setq pt2 (getpoint pt1 "\nSpecify second point: ")))<br />   (if pt2<br />     (progn<br />       (setq pt1 (3dPoint->2dPoint pt1)<br />             pt2 (3dPoint->2dPoint pt2))<br />       (setq os (getvar "osmode")<br />             cmd (getvar "cmdecho"))<br />       (setvar "osmode" 0)<br />       (setvar "cmdecho" 0)<br />       (command str_in ss1 "" pt1 pt2)<br />       (setvar "osmode" os)<br />       (setvar "cmdecho" cmd)<br />     );progn<br />   );if<br /> );end<br /> <br />