[LISP程序]：帮帮忙，求救啊

lxz0929

2. (Defun C:SPLL()
   
3.        (PrinC "\n这是对 Spline 进行数据分析的基本程序...")
   
4.        (While(progn(setq pen(car(entsel "\n指定一条 Spline: ")))
   
5.                         (/= "SPLINE"(cdr(assoc 0 (entget pen))))
   
6.                 )
   
7.                 (Alert "所指对象不是 Spline，请重新指定...")
   
8.        )
   
9.   (princ "\这是一条：")
   
10.   (setq s (getstring))
    
11.   (princ "\请选择原点：")
    
12.   (setq pt1(getpoint))
    
13.   (print pt1)
    
14.   (setq a1(car pt1))
    
15.   (setq a2(cadr pt1))
    
16.   (setq ent(entget pen))
    
17.   (setq ct 0)
    
18.   (textpage)
    
19.   (princ"\n 拟合点的坐标值:")
    
20.   (setq c1(length ent))
    
21.   (while(< ct c1)
    
22.    (setq d2(car(nth ct ent)))
    
23.       (if(= 10 d2)
    
24. (progn
    
25.    (setq d3(cdr(nth ct ent)))
    
26.    (setq b1(car d3))
    
27.    (setq b2(cadr d3))
    
28.    (setq b1(- b1 a1))
    
29.    (setq b1(abs b1))
    
30.    (setq b2(- b2 a2))
    
31.    (setq b2(abs b2))
    
32.    (subst b1 (car d3) ent)
    
33.    (subst b2 (cadr d3) ent)
    
34.    (setq d3(cdr(nth ct ent)))
    
35.    (print d3)
    
36.    )
    
37.       )
    
38.    (setq ct(+ 1 ct))
    
39.   )
    
40.   (print)
    
41.   )
    
42. 修改原先的数据，但好象不行！不知怎么做了！
    
43. 
    
44. 另外如何另存在一个EXCEL文件中？！

(Defun C:SPLL() <br />        (PrinC "\n这是对 Spline 进行数据分析的基本程序...") <br />        (While(progn(setq pen(car(entsel "\n指定一条 Spline: "))) <br />                         (/= "SPLINE"(cdr(assoc 0 (entget pen)))) <br />                 ) <br />                 (Alert "所指对象不是 Spline，请重新指定...") <br />        )<br />   (princ "\这是一条：")<br />   (setq s (getstring))<br />   (princ "\请选择原点：")<br />   (setq pt1(getpoint))<br />   (print pt1)<br />   (setq a1(car pt1))<br />   (setq a2(cadr pt1))<br />   (setq ent(entget pen))<br />   (setq ct 0)<br />   (textpage)<br />   (princ"\n 拟合点的坐标值:")<br />   (setq c1(length ent))<br />   (while(< ct c1)<br />    (setq d2(car(nth ct ent)))<br />       (if(= 10 d2)<br /> (progn<br />    (setq d3(cdr(nth ct ent)))<br />    (setq b1(car d3))<br />    (setq b2(cadr d3))<br />    (setq b1(- b1 a1))<br />    (setq b1(abs b1))<br />    (setq b2(- b2 a2))<br />    (setq b2(abs b2))<br />    (subst b1 (car d3) ent)<br />    (subst b2 (cadr d3) ent)<br />    (setq d3(cdr(nth ct ent)))<br />    (print d3)<br />    )<br />       )<br />    (setq ct(+ 1 ct))<br />   )<br />   (print)<br />   )<br /> 修改原先的数据，但好象不行！不知怎么做了！<br /> <br /> 另外如何另存在一个EXCEL文件中？！

xyp1964

[php](load "xyp_lib");加载通用函数
;|
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
通用函数下载地址:
http://www.xdcad.net/forum/attachment.php?s=&postid=1606661
|;

(defun c:test ()
  (CMDLA0)
  (jzhz)
  ;|
  (setq tx2 (UKWORD 1 "Y N" "\n是否输出顶点坐标数据：Y-是/N-否" tx2))
  (if (= tx2 "Y")
    (setq ffn (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
          ff  (open ffn "w")
    )
  )
  |;
  (setq        s1     (usel1 0 "SPLINE" "SPLINE线")
        lst    (entget (car s1))
        lstbak lst
        lst10  '()
        lst11  '()
  )
  (mkla "控制点" 1)
  (while (setq ls1 (assoc 10 lst))
    (setq pt1        (dxf 10 lst)
          lst        (vl-remove ls1 lst)
          lst10        (cons pt1 lst10)
    )
    (X_zb pt1)
  )
  (setq lst lstbak)
  (mkla "拟合点" 3)
  (while (setq ls1 (assoc 11 lst))
    (setq pt1        (dxf 11 lst)
          lst        (vl-remove ls1 lst)
          lst11        (cons pt1 lst11)
    )
    (X_zb pt1)
  )

  ;|
  (if (= tx2 "Y")
    (progn
      (close ff)
      (princ (strcat "\n 坐标写至=>" ffn))
    )
  )
  |;
                                        ;(princ lst10);控制点
                                        ;(princ lst11);拟合点
  (CMDLA1)
)[/php]