简化经常用到的函数符号，"E:\\ELLA\\" 是默认文件夹
(SETQ Z: CADDR # MAPCAR APP APPEND \ REVERSE
READL READ-LINE &DIR "E:\\ELLA\\" )

(DEFUN 1X(I Q )(# '* (LIST I I I ) Q ))
(DEFUN K*(A )(IF &K (# '* A (LIST &K &K &K )) A ))
(DEFUN PO+(A )(IF PO (# '+ PO A ) A ))
(DEFUN POH(A )(PO+ (K* A )))
(DEFUN QLX(P Q X X: / A )
(SETQ A (X: P ) A (/ (- X A )(- (X: Q ) A )))
(# '+ (1X (- 1.0 A ) P )(1X A Q ))
)
(DEFUN R*(P Q )(APPLY '+ (# '* P Q )))
(DEFUN C*(P Q / X Y C S )
(SETQ X (CAR P ) Y (CADR P ) C (CAR Q ) S (CADR Q ))
(LIST (- (* X C )(* Y S ))(+ (* X S )(* Y C ))(CADDR P ))
)
(DEFUN LINE(A )(IF A
(APPLY 'COMMAND (APP '("PLINE" )(# 'POH A ) '("" )))))
(DEFUN L#(A )(IF (ATOM (CAAR A ))(LINE A )(# 'LINE A )))

(DEFUN ==>(LU LL )(SET LL (CONS LU (EVAL LL ))))
(DEFUN EH(K L A )
(==> (IF A A (CAR (EVAL L ))) K )(SET L (CDR (EVAL L )))
(OR (EVAL L )(SET L (LIST (LIST (ZI+ )))))
)
(DEFUN ZU+(*+ /- )(SETQ R (EVAL K )
P (CAAR R ))(/- (*+ P P )(CAADR R )))
(DEFUN ELL(L P Q )(EEL P L )(EEL P Q ))
(DEFUN EEL(P Q )
(SETQ ZO (Z: P ) Z (Z: Q ))
(IF (> ZO Z )(SETQ R ZO ZO Z Z R ))
(WHILE (< ZO (CAAR F ))(EH 'F 'E NIL ))
(WHILE (> ZO (CAAR F ))(EH 'E 'F NIL ))
(WHILE (<= (CAAR F ) Z ); 计算线段与高程面交点
(EH 'E 'F (LLX (CAR F )(QLX P Q (CAAR F ) Z: ))))
)

(DEFUN XY+(Z )(SETQ X (1+ X ))(LIST X Y Z ))
(DEFUN ALINE()(IF (/= "" R )(SETQ X -1.0
Y (1+ Y ) R (RLI ) A (A+ ) L (MIN L (APPLY 'MIN R )))))
(DEFUN RLI()(READ (STRCAT "(" R ")" )))
(DEFUN LLX(F P / L )(CONS (CAR F )
(IF (CADDR F )(LAX (CDR F ))(CONS P (CDR F )))))
(DEFUN LAX(F ); 识别和处理分离点
(IF (ATOM (CAAR F ))(IF (L+ ) L (P->F ))
(PROGN (LUX )(>>F )(IF L (CONS (CAR L ) F ) F )))
)
(DEFUN LUX()(SETQ K (# 'KL F ); 点线搭配连线
I (APPLY 'MIN K ) F (# 'KF K F )) L )
(DEFUN KL(F )(-R- P (CAR F )))
(DEFUN KF(K F )(IF (/= I K )
F (IF (CADR F )(IF (L+ )(CADR L )(P->F ))(CONS P F ))))
(DEFUN P->F()(IF (> Q` 0.0 )(CONS P F )(P->L )))

(DEFUN P->L( / E E1 F1 )
(SETQ E (LIST (CAR F )) F (CDR F ))
(WHILE (AND F (SETQ E1 (CAR E ) F1 (CAR F ))
(NOT (< (MAX (-R- P E1 )(-R- P F1 ))(-R- E1 F1 ))))
(SETQ E (CONS F1 E ) F (CDR F ))
)
(IF F (APP (\ E )(LIST P ) F )(CONS P E ))
)
(DEFUN >>F()(WHILE (/= I (CAR K ))
(SETQ K (CDR K ) F (APP (CDR F )(LIST (CAR F ))))))
(DEFUN L+()
(SETQ J (IL F ) V (-R- P (CAR F )) U (-R- P (CADR F ))
Q` (COS`2 F P ) L (< -0.86 Q` 0.86 ) L
(IF (AND (> V U )(> J U )); 检测到回头
(IF L (LIST (LIST (CAR F ))(CONS P (CDR F )))) ; 线中有离散点
(IF (OR L (< 5.0 (MIN U V )))
(IF (< J V )(LIST (LIST P ) F )
(LIST (LIST P (CAR F ))(CDR F )))))
))

(DEFUN COS`2(L P )(COS^2
(
# '- P (CAR L ))(#
'- (CAR L )(CADR L ))))
(DEFUN COS^2(L P / R )(SETQ R (R* P L ))
(/ (* R (ABS R ))(* (R* P P )(R* L L ))))
(DEFUN IL(P )(IF (CADR P )(-R- (CAR P )(CADR P )) 0.0 ))
(DEFUN -R-(P Q )(APPLY '+ (
# 'ABS (#
'- P Q ))))
; 为提高处理速度，计算线段伪长度不计算真长度
(DEFUN RLL(X )(X (-R- P (CAR F ))(-R- P (LAST F ))))
(DEFUN KI(F )(RLL MIN ))
(DEFUN KU(K F )(IF (/= I K ) F (PUL P (IF (RLL < ) F (\ F )))))
(DEFUN PUL(P L )(IF (MINUSP (COS`2 L P ))
(PROGN (==> (LIST P ) 'X ) L )(CONS P L )))
(DEFUN UUL(L / O F P SLX X )
(FOREACH L L (==> L (IF (CADR L ) 'F 'P ))); 筛选孤点
(FOREACH P (# 'CAR P ); 孤点连接邻近的线
(SETQ K (# 'KI F ) I (APPLY 'MIN K ) F (# 'KU K F )))
(SETQ SLX (IF P SLL SL ))
(APP (UL (IF X (APP (UL X PPL ) F ) F ) VVL ) O )
)

(DEFUN UL(F VLX / A E ); 断线搭配
(WHILE (CADR F )
(SETQ P (CAR F ) Q (CADR F ) F (CDDR F ))
(OR (VLX )(SETQ E (APP E (LIST Q )) F (CONS P F )))
(AND E (NULL (CADR F ))(SETQ F (APP E F ) E NIL ))
)
(APP A F )
)
(DEFUN PPL()(IF (/\ )(==> (APP P Q ) 'A ))); 邻近 2 孤点连成线
(DEFUN VVL()(SETQ P`(\ P ) Q`(\ Q ))(OR (VL Q` Q )(VL Q Q`)))
(DEFUN VL(Q Q` )(SETQ V (SLX P` Q` )); 邻近线段拼接
(IF (SLX P Q )(IF V (==> (QL ) 'O )
(==> (APP P` Q ) 'F ))(IF V (==> (APP P Q` ) 'F )))
)
(DEFUN SL(P Q )(AND (/\ )(CUL P Q )(CUL Q P ))) ; 判断接口顺接情况
(DEFUN SLL(P Q )
(SETQ K (COS`2 P (CAR Q )) R (COS`2 Q (CAR P )))
(AND (/\ )(> K -0.25 )(> R -0.25 )(> (+ K R ) 0.25 ))
)
(DEFUN CUL(P Q )(> (COS`2 P (CAR Q )) 0.0 ))
(DEFUN /\()(< (-R- (CAR P )(CAR Q )) 2.0 )); 判断线头靠近

(DEFUN QL(); 去掉瑕疵点
(SETQ L (APP P Q` (LIST (CAR P )(CADR P ))) X NIL
U (C- (LAST Q` )(CAR L )(CADR L ))
I (C- (CAR L )(CADR L )(CADDR L )) J I
L (# 'VH (CDR L )(CDDR L )(CDDDR L ))
R (LIST (IF (AND (/= I U )(/= I J ))(CADR P )(CAR P )))
)
(APP R L R ); 闭合线
)
(DEFUN VH(P Q R )(SETQ K (C- P Q R ))
(IF X (SETQ X NIL )(AND (/= I U )(/= I K )(SETQ P Q X T )))
(SETQ U I I K ) P
)
(DEFUN C-(P Q R ) ; 检查 3 点连线弯曲方向
(MINUSP (CADR (C* (# '- R Q )(-Y (# '- Q P ))))))
(DEFUN -Y(P )(LIST (CAR P )(- (CADR P ))(CADDR P )))

可以由其他语言生成点阵数据，储存在 AAA.TXT 文件中
如果画出的等值线过疏或者过密
数据文件开头一行可以写等值线数值样品，比如 8 9 10

下面是主程序
(DEFUN ELLA(AL / A E F I J
K L P P` Q Q` R U V X Y Z ZO ) ; 由离散点画等值线图
(SETVAR "OSMODE" 0 )(SETVAR "CECOLOR" "3" )
(SETQ PO '(200 50 0 ) &K 8 Y -1.0 L 10.0 )
(AND (SETQ F (OPEN (STRCAT &DIR AL ) "r" ))
(WHILE (= "" (SETQ R (READL F ))) T )
(IF (< (STRLEN R ) 50 )(SETQ Z (RLI ) R (READL F )) T )
(DEFUN A+()(APP A (LIST (# 'XY+ R ))))(ALINE )
(WHILE (SETQ R (READL F ))(ALINE ))(CLOSE F )
)
(IF (MINUSP L )
(SETQ F '(-0.5 0.0 0.5 ) ZI+
(LAMBDA()(SETQ X (CAAR (EVAL K )))(+ X X )))
(IF (< L 1.0 )
(SETQ F '(0.5 1.0 2.0 ) ZI+ (LAMBDA()(ZU+ * / )))
(SETQ F '(10 20 30 ) ZI+ (LAMBDA()(ZU+ + - )))
))
(SETQ F (# 'LIST (IF Z Z F )))(EH 'E 'F NIL )
(SETQ L (CAR A ))(# 'EEL L (CDR L ))
(FOREACH A (CDR A )(# 'ELL L A (CDR A ))(SETQ L A ))
(FOREACH I (
# 'CDR (APP (\ E ) F )) ; (L#
I ))
(L# (IF (LISTP (CAAR I ))(UUL I ) I )))
)
(ELLA "AAA.TXT")