Tools/代码/LSP/GB512/lisptool/acadv202.lsp

(defun c:lgq()
     (setq bili (= 5 6))
     (setq point (getstring "\nChange size of point (y/n) ? :"))
     (setq size (getreal "\nScale factor <8.33> ? :"))
     (prin1)
)
(defun C:TB()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (command "layer" "m" "8616" "c" "3""""")
     (setq zp (getpoint "Input Point Position , Please !"))
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq x (car zp))        
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (SETQ LM (+ LMA 1.5))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* 0.001875 bili)))) 
     (setq ap (list  x  (- y (* bili 0.001875)))) 
     (command "text" "j" "mc" zp (* bili 0.0024) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* 0.0024 bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lm 0.001875 bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)

(defun C:CCH()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (command "insert" "c:/maped/lib/ch" zp bili """")
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCC()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (if (< bili 2500) (command "insert" "c:/maped/lib/cc" zp bili """"))
     (if (> bili 2500) (command "insert" "c:/maped/lib/c3" zp bili """")) 
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCG()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (if (< bili 2500) (command "insert" "c:/maped/lib/cg" zp bili """"))
     (if (> bili 2500) (command "insert" "c:/maped/lib/c5" zp bili """"))
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCF()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (if (< bili 2500) (command "insert" "c:/maped/lib/cf" zp bili """"))
     (if (> bili 2500) (command "insert" "c:/maped/lib/c5" zp bili """")) 
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCI()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (if (< bili 2500) (command "insert" "c:/maped/lib/ci" zp bili """"))
     (if (> bili 2500) (command "insert" "c:/maped/lib/c7" zp bili """"))
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCB()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (setq xg 0.002)
     (setq xk 0.0015)
     (if (< bili 2500) (progn
                       (setq xg 0.0024)
                       (setq xk 0.0018)
                       )
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (if (< bili 2500) (command "insert" "c:/maped/lib/cb" zp bili """"))
     (if (> bili 2500) (command "insert" "c:/maped/lib/c1" zp bili """"))
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* xk bili)))) 
     (setq ap (list  x  (- y (* bili xk)))) 
     (command "text" "j" "mc" zp (* bili xg) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* xg bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma xk bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:CCK()
     (while (= bili nil)
        (setq bili (getint "input scale parameter:"))
     )
     (command "layer" "m" "9212" "c" "1""""")
     (setq l1 (getstring "\nEnter  Up  Number:"))
     (setq l2 (getstring "\nEnter Down Number:"))
     (setq zp (getpoint "Input Point Position , Please !"))
     (command "insert" "c:/maped/lib/ck" zp bili """")
     (setq x (car zp))
     (setq y (cadr zp))
     (setq lma ( max (strlen l1) (strlen l2)))
     (setq ss (ssadd))      
     (setq zp (list  x (+ y (* 0.0015 bili)))) 
     (setq ap (list  x  (- y (* bili 0.0015)))) 
     (command "text" "j" "mc" zp (* bili 0.002) 0 l1)
     (setq ss (ssadd (entlast) ss))
     (command "text" "j" "mc" ap (* 0.002 bili) 0 l2)
     (setq ss (ssadd (entlast) ss))
     (setq lgq (* lma 0.0015 bili))
     (setq bp (list (- x (-(/ lgq 2 ) (* 0.0008 bili))) y))
     (setq cp (list (- (+ x (/ lgq 2)) (* 0.0008 bili)) y))
     (command "line" bp cp "")
     (setq ss (ssadd (entlast) ss))
     (COMMAND "MOVE" SS "" ZP)
     (prin1)
)
(defun C:3p()
 (graphscr)
 (setq pt1(getpoint"\nFirst point:"))
 (setq pt2(getpoint"\nSecond point:"))
 (setq pt3(getpoint"\nThird point:"))
 (setq x1  (car pt1))
 (setq x2  (car pt2))
 (setq x3  (car pt3))
 (setq y1  (cadr pt1))
 (setq y2  (cadr pt2))
 (setq y3  (cadr pt3))
 (setq x (- x2 x1))
 (setq y (- y2 y1))
 (setq x4 (- x3 x))
 (setq y4 (- y3 y))
 (setq pt4 (list x4 y4))
 (command "pline" pt1 pt2 pt3 pt4 "c")
)
(defun c:clean()
  (Gc)
)
  (defun c:dellayer()
     (setq l (strcase(getstring "\nEnter layer to delete:")))
     (setq e (entnext))
     (while e
       (if(= l (cdr(assoc 8 (entget e))))
         (entdel e)
       )
     (setq e (entnext e))
     )
  )
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;; DouKan;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun c:dk()
        (setq p (list 0 0))
        (command "insert" "c:/maped/lib/dk" p "" "" "")
        (setq pp (ssadd(entlast)))
        (command "erase" pp "")
        (setq ee (entsel "Select a DouKan ShangBianYuan:"))
        (setq e (car ee))
        (setq ppp (ssadd))
        (setq ppp ee)
        (command "measure" ppp "B""dk""y""1.5")
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;; JiaGuDouKan;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun c:jgdk()
        (setq p (list 0 0))
        (command "insert" "c:/maped/lib/jg" p "" "" "")
        (setq pp (ssadd(entlast)))
        (command "erase" pp "")
 8       (setq ee (entsel "Select a DouKan ShangBianYuan:"))
        (setq e (car ee))
        (setq ppp (ssadd))
        (setq ppp ee)
        (command "measure" ppp "B""jg""y""3")
  )
(defun c:end (/ a)
  (setq a (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (initget "Yes No")
  (if (= (getkword "\nEND the drawing session?  Yes/<No>: ") "Yes")
    (command "save" "" "quit" "y")
    (princ "\nYou must enter Yes to END a drawing session.")
  )
  (if a (setvar "cmdecho" a))
2  (princ)
)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;; XuanYa;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun c:xy()
        (setq p (list 0 0))
        (command "insert" "c:/maped/lib/g8" p "" "" "")
        (setq pp (ssadd(entlast)))
        (command "erase" pp "")
        (setq ee (entsel "XuanZe a XuanYa ShangBianYuan:"))
        (setq e (car ee))
        (setq ppp (ssadd))
        (setq ppp ee)
        (command "measure" ppp "B""g8""y""7.5")
    (princ)
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;; XuanYa;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun c:dy()
        (command "layer" "m" "9553" "c" "1""""")
        (while (= bili nil)
              (setq bili (getint "\nEnter scale :"))
        )
        (setq p1 (getpoint "\nEnter first point :"))
        (setq p2 (getpoint "\nEnter second point :"))
        (setq dd(distance p1 p2))
        (setq ddd(* (/ dd bili) 1000))
        (while (<= ddd 3)
           (command "insert" "c:/maped/lib/gg3" p1 (/ dd 0.004) (getorient p1) """")
        )
        (while (<= ddd 10)
           (command "insert" "c:/maped/lib/g9" p1 (/ dd 0.004) (getorient p1) """")        
        )
        (while (<= ddd 20)
           (command "insert" "c:/maped/lib/gg20" p1 (/ dd 0.004) (getorient p1) """")        
        )
        (while (> ddd 20)
           (command "insert" "c:/maped/lib/gg30" p1 (/ dd 0.004) (getorient p1) """")        
        )
       (princ1)
  )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;; XiePo;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun c:xp()
        (princ "Select Top Line And Bottom Line Of XiePo !")
        (command "hatch" "triang""25""")
  )
(defun c:a()
    (command "pline" "end")
)
  (defun c:xyx()
        (setq p (list 0 0))
        (command "insert" "c:/maped/lib/xyx" p "" "" "")
        (setq pp (ssadd(entlast)))
        (command "erase" pp "")
        (setq ee (entsel "XuanZe a XuanYa ShangBianYuan:"))
        (setq e (car ee))
        (setq ppp (ssadd))
        (setq ppp ee)
        (command "measure" ppp "B""xyx""y""7.5")
    (princ)
  )

(DEFUN S::STARTUP()
(SETQ ENVV (GETENV "CAMEXE"))
(IF (= ENVV nil) (SETQ ENVV "") (SETQ ENVV (STRCAT ENVV "\\")))
(SETQ MENX ENVV)
(SETQ ODOSNP 0 CCLAYER (GETVAR "CLAYER") ODPDM 0)
(SETQ NAME (GETVAR "DWGNAME"))
(SETQ NAME (STRCAT NAME ".ASC"))
(setq bilichi 1000)
(SETQ DTF (OPEN NAME "r"))
 (IF (/= DTF nil)
     (PROGN
     (SETQ BILICHI (ATOI (READ-LINE DTF)))
     (CLOSE DTF)
     )
 )
(SETVAR "LTSCALE" BILICHI)
(SETQ ENVV (STRCAT MENX "order"))
(if(= (ads) nil) (XLOAD ENVV))
(SETQ SYMV (GETENV "CAMLIB"))
(IF (= SYMV nil) (SETQ SYMV "") (SETQ SYMV (STRCAT SYMV "\\")))
(PRINC)
(load "appload")
)

(DEFUN MYERROR (SMG)
  (COMMAND "OSNAP" "off")
  (COMMAND "LAYER" "S" CCLAYER "")
  (SETVAR "EXPERT" 1)
  (PRINC " ** ERROR ** ")
  (PRINC SMG)
  (SETQ *ERROR* SERROR)
  (PRINC)
)


(DEFUN LRDCHAR(MSG DCHAR CH / D)
 (IF (NOT DCHAR) (SETQ D "Y") (SETQ D DCHAR))
 (PRINC MSG)
 (IF(NOT CH) (SETQ CH CH)
    (PROGN
       (PRINC " （")
       (PRINC CH)
       (PRINC " ）")
    )
 )
 (PRINC " ＜")
 (PRINC D)
 (PRINC "＞:")
 (IF (NOT CH)
        (SETQ CCHAR (GETSTRING " "))
        (PROGN
           (INITGET 0 CH)
           (SETQ CCHAR (GETKWORD " "))
        )
 )
 (IF (OR (= CCHAR "") (NOT CCHAR)) (SETQ CCHAR D))
)

(DEFUN C:tbcover()
(SETQ ENVV (STRCAT MENX "cover"))
(XLOAD ENVV)
(C:cover)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:cal()
(SETQ ENVV (STRCAT MENX "cal"))
(XLOAD ENVV)
(C:cal)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:itematch()
(SETQ ENVV (STRCAT MENX "itematch"))
(XLOAD ENVV)
(C:itematch)
(princ)
)
(DEFUN C:prematch()
(SETQ ENVV (STRCAT MENX "prematch"))
(XLOAD ENVV)
(setq retval (C:pre))
(if (= retval nil) (setq retval 0))
(xunload ENVV)
(if (= retval 2) (command "quit" "y"))
(princ)
)
(DEFUN C:cleanx()
(SETQ ENVV (STRCAT MENX "cleanx"))
(XLOAD ENVV)
(C:cleanxy)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:mpdarc()
(SETQ ENVV (STRCAT MENX "arcinfor"))
(XLOAD ENVV)
(C:arcinfor)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:postmtch()
(SETQ ENVV (STRCAT MENX "postmtch"))
(XLOAD ENVV)
(setq retval (C:post))
(if (= retval nil) (setq retval 0))
(xunload ENVV)
(if (= retval 1) (command "quit" "y"))
(princ)
)
(DEFUN C:lineSYM()
(SETQ ENVV (STRCAT MENX "linet"))
(XLOAD ENVV)
(C:LINET)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:LM()
(SETQ ENVV (STRCAT MENX "linet"))
(XLOAD ENVV)
(C:LINET)
(XUNLOAD ENVV)
(PRINC)
)
(DEFUN C:L_SYM_T()
(SETQ ENVV (STRCAT MENX "linett"))
(XLOAD ENVV)
(C:LINETT)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:SMOOTH()
(SETQ ENVV (STRCAT MENX "linet"))
(XLOAD ENVV)
(C:autospl)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:SML()
(SETQ ENVV (STRCAT MENX "linet"))
(XLOAD ENVV)
(C:pk_point)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:JXINPUT()
(SETQ ENVV (STRCAT MENX "dwgtrf"))
(XLOAD ENVV)
(C:TRANSF)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:AUTOMTCH()
(SETQ ENVV (STRCAT MENX "autojb"))
(XLOAD ENVV)
(C:AUTOJB)
(princ)
)
(DEFUN C:P&TEXT()
(SETQ ENVV (STRCAT MENX "hs_list"))
(XLOAD ENVV)
(C:p&text)
(princ)
)
(DEFUN C:HS_list()
(SETQ ENVV (STRCAT MENX "hs_list"))
(XLOAD ENVV)
(C:hs_list)
(princ)
)
(DEFUN C:hs_coor()
(SETQ ENVV (STRCAT MENX "hs_list"))
(XLOAD ENVV)
(C:hs_coor)
(princ)
)
(DEFUN C:XSQUARE()
(SETQ ENVV (STRCAT MENX "AUTOGFW"))
(XLOAD ENVV)
(C:AUTOGFW)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:STD_OUT()
(SETQ ENVV (STRCAT MENX "STD_OUT"))
(XLOAD ENVV)
(C:STD_OUT)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:STD_IN()
(SETQ ENVV (STRCAT MENX "STD_IN"))
(XLOAD ENVV)
(C:STD_IN)
(XUNLOAD ENVV)
(princ)
)
(DEFUN C:SET2()
(SETQ ENVV (STRCAT MENX "SET2"))
(XLOAD ENVV)
(C:SET2)
)
(DEFUN C:QMTCH()
(C:QAUTOJB)
(XUNLOAD ENVV)
(COMMAND "QUIT" "Y")
)
(DEFUN C:FDEM()
(SETQ ENVV (STRCAT MENX "FFDEM"))
(XLOAD ENVV)
(C:FDEM)
(princ)
)
(DEFUN C:DPTIN()
(SETQ ENVV (STRCAT MENX "FFDEM"))
(XLOAD ENVV)
(C:DPTIN)
(princ)
)
(DEFUN C:ADJUST()
(SETQ ENVV (STRCAT MENX "RELE"))
(LOAD ENVV)
(C:ADJUST)
(princ)
)
(DEFUN C:HOUSTCH()
(SETQ ENVV (STRCAT MENX "TANG"))
(XLOAD ENVV)
(C:HOUSTCH)
(princ)
)

(DEFUN C:movela()
(SETQ ENVV (STRCAT MENX "mpd_zhng"))
(XLOAD ENVV)
(C:movela)
(princ)
)

(DEFUN C:mergela()
(SETQ ENVV (STRCAT MENX "mpd_zhng"))
(XLOAD ENVV)
(C:mergela)
(princ)
)

(DEFUN C:SINSRT()
(SETQ ENVV (STRCAT MENX "TANG"))
(XLOAD ENVV)
(C:SINSRT)
(princ)
)
(DEFUN C:MINSRT()
(SETQ ENVV (STRCAT MENX "TANG"))
(XLOAD ENVV)
(C:MINSRT)
(princ)
)
(DEFUN C:AREADIM()
(SETQ ENVV (STRCAT MENX "TANG"))
(XLOAD ENVV)
(C:AREADIM)
(princ)
)
(DEFUN C:AREASYM()
(SETQ ENVV (STRCAT MENX "TANG"))
(XLOAD ENVV)
(C:AREASYM)
(princ)
)
(DEFUN C:SYMSYM()
    (command "VSLIDE" (strcat symv "SYM"))
    (princ)
)

(DEFUN C:SYM123T()
    (command "VSLIDE" (strcat symv "123T"))
    (princ)
)

(DEFUN C:SYMC()
    (command "VSLIDE" (strcat symv "C"))
    (princ)
)

(DEFUN C:SYMHS()
    (command "VSLIDE" (strcat symv "HS"))
    (princ)
)

(DEFUN C:SYMI()
    (command "VSLIDE" (strcat symv "I"))
    (princ)
)
(DEFUN C:SYMO()
    (command "VSLIDE" (strcat symv "O"))
    (princ)
)
(DEFUN C:SYMPR()
    (command "VSLIDE" (strcat symv "PR"))
    (princ)
)
(DEFUN C:SYMVG()
    (command "VSLIDE" (strcat symv "VG"))
    (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:fe(/ ZP X XX AP)
     (while (= BILI nil)
        (setq BILI (getreal "Input scale parameter:"))
     )
     (command "layer" "m" "9212" "c" "32""""")
     (setq zp (getpoint "Input Point Position , Please !"))
     (setq z1 (car zp))
     (setq z2 (cdr zp))
     (setq zp1 (cons z1 z2))
     (command "insert" "c:/maped/lib/aa" zp1 (* 2.5 bili) """")
     (setq x (car zp))
     (setq xx (+ x (* bili 0.001)))
     (setq ap (subst xx x zp))
     (command "text" "j" "ml" ap (* bili 0.002) 0 )
     (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:1300()
    (command "layer" "m" "1300" "c" "3""""")
)
(defun c:8615()
    (command "layer" "m" "8615" "c" "3""""")
)
(defun c:8610()
    (command "layer" "m" "8610" "c" "3""""")
)
(defun c:2100()
    (command "layer" "m" "2100" "c" "1""""")
)
(defun c:2440()
    (command "layer" "m" "2440" "c" "1""""")
)
(defun c:9120()
    (command "layer" "m" "9120" "c" "2""""")
)
(defun c:9110()
    (command "layer" "m" "9110" "c" "7""""")
)
(defun c:zdm1()
     (while (= bili nil)
        (setq bili (getint "输入横比例尺:"))
        (setq biliv (getint "输入纵比例尺:"))  
     )
  (setq kk (/ bili biliv))
  (setq loop "y")
  (while (= loop "y")
     (setq xy (getpoint "输入累距和高程 S,H !:"))
     (setq s (car xy))        
     (setq h (cadr xy))
     (setq h (* h kk))
     (setq xy (list s h))
     (command "layer" "m" "dm" "c" "5""""")
     (command "insert" "c:/maped/lib/p2" xy bili """")  
     (while (> s 0)
        (command "line" xy0 xy "")
        (setq s 0)
     )
     (setq xy0 xy)
  )
     (prin1)
)

(defun c:sectionv()
     (while (= bilih nil)
        (setq bilih (getint "输入断面图的横比例尺: "))
     )
     (while (= biliv nil)
        (setq biliv (getint "输入断面图的纵比例尺: "))
     )
  (setq scale (/ bilih biliv))
  (setq j 0)
  (setq sum 0)
  (setq xg "n")
  (setq xg (getstring "\n要修改错误吗 ? :(Y/N)"))
  (if (= xg "y") (progn
      (setq j 10)
      (setq sum (- sum s1))
      )
  )    
  (setq loop "y")
  (while (= loop "y")
     (setq xy (getpoint "\n输入断面点的坐标--X,Y !"))
     (setq H (getreal "\n输入断面点的高程--H !"))
     (if (= j 0)
         (setq xy0 xy)
     )
     (setq s1 (distance xy xy0))
     (setq xy0 xy)
     (setq sum (+ sum s1))
     (setq xyz (list sum (* h scale)))
     (command "layer" "m" "dm" "c" "5""""")
     (if (/= xg "y") (progn
         (command "insert" "c:/maped/lib/p2" xyz bilih """")  
         (if (/= j 0)
             (command "line" xyz0 xyz "")
         )
         )
     )
     (setq xg "n")
     (setq j 10)
     (setq xyz0 xyz)
  )
     (prin1)
)
(defun c:bzt()
     (while (= bilih nil)
        (setq bilih (getint "\n输入断面图的比例尺: "))
     )
  (setq loop "y")
  (setq j 0)
  (while (= loop "y")
     (command "layer" "m" "dm" "c" "5""""")   
     (setq l1 (getstring "\n输入纵断面点点号 : "))
     (setq xy (getpoint "\n输入纵断面点的坐标--X,Y !"))
     (setq bb 0)
     (setq bx (getstring "\n没有横断面吗 ?大写Y/<N> :"))
     (if (/= bx "Y") (progn 
                    (setq bb (getreal "\n输入方位角  :"))
                    (setq bb (* bb (/ 3.1415926 180)))
                    )
     )
     (setq x (car xy))
     (setq y (cadr xy))
     (setq x1 (- x (* 100 (cos bb))))
     (setq y1 (- y (* 100 (sin bb))))
     (setq x2 (+ x (* 100 (cos bb))))
     (setq y2 (+ y (* 100 (sin bb))))
     (setq xy1 (list y1 x1))
     (setq xy2 (list y2 x2))
     (setq xy (list y x))
       (if (/= j 0)
           (command "line" xy0 xy "")
       )
       (if (/= bb 0)
           (command "line" xy1 xy2 "")
       )
    (setq zp (list (+ y (* 0.003 bilih)) x)) 
    (command "insert" "c:/maped/lib/p2" xy bilih """")   
    (command "layer" "m" "zj" "c" "1""""")  
    (command "text" "j" "mc" zp (* bilih 0.002) 0 l1) 
    (setq j 10)
    (setq xy0 xy)
  )
     (prin1)
)
(defun c:dtk()
    (command "layer" "m" "dtk" "c" "7""""")
)
(defun c:dkz()
    (command "layer" "m" "dkz" "c" "1""""")
)
(defun c:zb()
     (command "layer" "m" "zb""")
     (while (= bili nil)
       (setq bili (getreal "\n输入成图比例尺分母 :"))    
     )
     (setq tf5 (getstring "\n是50×50的图幅吗? 输入Y或N :"))
     (setq xxx 0.003)
     (setq yyy 0.0018)
     (setq hv "v") 
     (setq dh 0)
     (setq daihao (getstring "\有带号吗? 输入Y或N :"))
     (if (= daihao "y") 
         (setq dh (getreal "\n输入带号 :"))
     )    
     (setq xybl (getpoint "\n输入图幅在CAD中的西南角坐标y,x :"))
     (setq hv (getstring "\n图幅是横向<H>或是纵向<V>? :"))
     (setq y0 (+ (car xybl) (* dh 1e6)))
     (setq x0 (cadr xybl))
     (setq ybl (car xybl))
     (setq xbl (cadr xybl))
     (setq lo 1)
     (setq bl 1)
     (setq cs 0.4)
     (if (= tf5 "y") (setq cs 0.5))
     (if (< bili 1000) (setq bl 2))
     (while (<= lo 4)
       (setq cx 1)
       (setq cy 1)
       (if (or (= lo 1) (= lo 4)) (setq cx 0)) 
       (if (or (= lo 2) (= lo 1)) (setq cy 0))
       (if (= hv "v") (progn
           (setq xz (+ (* (* 0.5 cx) bili) x0))
           (setq yz (+ (* (* cs cy) bili) y0))
           (setq y (+ (* (* 0.5 cx) bili) xbl))
           (setq x (+ (* (* cs cy) bili) ybl))
           )
       )
       (if (= hv "h") (progn
           (setq xz (+ (* (* cs cx) bili) x0))
           (setq yz (+ (* (* 0.5 cy) bili) y0))
           (setq y (+ (* (* cs cx) bili) xbl))
           (setq x (+ (* (* 0.5 cy) bili) ybl))
           )
        )
        (setq xz (fix xz))
        (setq yz (fix yz))
        (setq xz (itoa xz)) 
        (setq yz (itoa yz))
        (setq xz1 " ")
        (setq yz1 " ")
        (setq xln (strlen xz))
        (setq yln (strlen yz))
        (if ( > xln 5) ( progn 
            (setq xz1 (substr xz 1 (- xln 5))) 
            (setq xz2 (substr xz (- xln 4) 2))
            (setq xz3 (substr xz (- xln 2) bl))
            ) ;end progn else 
                ( progn 
                  (setq xz2 (substr xz 1 (- xln 3)))
                  (setq xz3 (substr xz (- xln 2) bl))
               )
        )
        (setq xz2 (strcat xz2 "." xz3))
        (if ( > yln 5) ( progn 
            (setq yz1 (substr yz 1 (- yln 5))) 
            (setq yz2 (substr yz (- yln 4) 2))
            (setq yz3 (substr yz (- yln 2) bl))
            ); end progn else  
            ( progn 
                  (setq yz2 (substr yz 1 (- yln 3)))
                  (setq yz3 (substr yz (- yln 2) bl))
               )
        )
        (setq yz2 (strcat yz2 "." yz3))
        (setq x1 (- x (* bili (+ 0.0042 (* 0.00135 (strlen yz1)))))) 
        (setq x2 (- x (* bili 0.0042)))
        (setq x3 (- x (* bili (+ (* 0.00225 (- (strlen xz2) 1)) (* 0.00135 (strlen xz1))))))
        (setq x3 (+ x3 (* bili 0.0001)))
        (setq x4 (- x (* bili (* 0.00225 (- (strlen xz2) 1)))))
        (if ( or (= lo 3) (= lo 4)) ( progn
            (setq x3 (+ x (* bili 0.0002)))         
            (setq x3 (+ x3 (* bili 0.0001)))
            (setq x4 (+ x (* bili (+ (* (strlen xz1) 0.00135) 0.0002))))
            )
        )
        (setq yy 0.012)
        (if (>= bili 5000) (setq yy 0.0095))
        (setq y1 (- y (* bili (- yy 0.003))))
        (setq y2 (- y (* bili (- yy 0.0024))))
        (setq y3 (+ y (* bili 0.0027)))
        (setq y4 (+ y (* bili 0.0021)))
        (if (or ( = lo 2) (= lo 3)) (progn
            (setq y1 (+ y (* bili (- yy 0.0018))))
            (setq y2 (+ y (* bili (- yy 0.0024))))
            )
        )
        (setq pylx 0.0004)
        (setq pyld 0.0009)
        (if (or (= lo 1) (= lo 2)) (progn 
            (setq pylx 0)
            (setq pyld 0.0004)
            )
        )
        (setq xy1 (list x1 y1))
        (setq xy2 (list x2 y2)) 
        (setq xy3 (list (- x3 (* pylx bili)) y3))
        (setq xy4 (list (- x4 (* pyld bili)) y4))
        (command "text" "j" "ml" xy1 (* bili yyy) 0 yz1) 
        (command "text" "j" "ml" xy2 (* bili xxx) 0 yz2)
        (command "text" "j" "ml" xy3 (* bili yyy) 0 xz1) 
        (command "text" "j" "ml" xy4 (* bili xxx) 0 xz2)
        (setq lo (+ lo 1))
      )
      (setq loop "y")
      (setq zjg 3)
      (if (= tf5 "y") (setq zjg 4))
      (while (and (>= bili 5000) (= loop "y"))
             (setq lo 1)          
             (setq cx10 (* bili 0.1))
             (if (= hv "v") (progn
                 (setq zx 4)
                 (setq zy zjg)
                 )
             )
             (if (= hv "h") (progn
                 (setq zx zjg)
                 (setq zy 4)
                 )
             )
             (while (<= lo zy)
                (setq yz5 (+ y0 (* cx10 lo)))
                (setq x (- (+ ybl (* cx10 lo)) 21))
                (setq yz5 (fix yz5))
                (setq yz5 (itoa yz5))
                (setq ly (strlen yz5))
                (setq y1 (substr yz5 (- ly 4) 2))
                (setq y2 (substr yz5 (- ly 2) 1))
                (setq yz (strcat y1 "." y2))
                (setq yx (- xbl 35.5)) 
                (setq ys (+ xbl (+ 35.5 (* cx10 (+ zx 1)))))
                (setq y10 (list x yx))
                (setq y9 (list x ys))
                (command "text" "j" "ml" y10 (* bili xxx) 0 yz) 
                (command "text" "j" "ml" y9 (* bili xxx) 0 yz) 
                (setq lo (+ lo 1))
             )
             (setq lo 1)
             (while (<= lo zx)
                (setq xz5 (+ x0 (* cx10 lo)))
                (setq y (+ (+ xbl (* cx10 lo)) 10.5))
                (setq xz5 (fix xz5))
                (setq xz5 (itoa xz5))
                (setq ly (strlen xz5))
                (setq y1 (substr xz5 (- ly 4) 2))
                (setq y2 (substr xz5 (- ly 2) 1))
                (setq xz (strcat y1 "." y2))
                (setq xl (- ybl 39)) 
                (setq xr (+ ybl (+ 6 (* cx10 (+ zy 1)))))
                (setq x10 (list xl y))
                (setq x9 (list xr y))
                (command "text" "j" "ml" x10 (* bili xxx) 0 xz) 
                (command "text" "j" "ml" x9 (* bili xxx) 0 xz) 
                (setq lo (+ lo 1))
             )
             (setq loop "n")
      )
      (princ)
)

(defun c:8613()
    (command "layer" "m" "8613" "c" "3""""")
)
(defun c:8611()
    (command "layer" "m" "8611" "c" "3""""")
)
(defun c:8612()
    (command "layer" "m" "8612" "c" "3""""")
)
(defun c:9111()
    (command "layer" "m" "9111" "c" "7""""")
)
(defun c:9121()
    (command "layer" "m" "9121" "c" "2""""")
)
 (defun c:zj1(/ name ename ee e pl elev0 xy1 x1 y1 a aa ang elev1 txt)
     (command "layer" "m" "9121-sym" "c" "1""""")
     ;(SETQ BILI nil)
     (while (= BILI nil)
        (setq BILI (getint "Input scale parameter:"))
     )
     (setq name nil)
     (while (not(or (= name "LINE")(= name "POLYLINE")))(progn
        (setq ename nil)
        (setq ee (entsel "Select a DengGaoXian:"))
        (setq e (car ee))
          (if e(progn
              (setq pl (entget e))
              (SETQ ELEV0 (caddr(cdr(assoc 10 pl))))
              (setq name (cdr(assoc 0 pl)))
              (setq ename e)
               (if(or(= name "LINE")(= name "POLYLINE"))(progn
                    (princ(strcat "\n"name"selected\n"))
               );end progn else
                  (progn (princ "\nThat's not a DengGaoXian,it's a ")(princ name)(princ "\n"))
               );end if
              );end progn
            ;else
             (princ "\nNothing Selected\n")
          );end if 
     ));end while
     (setq xy1 (car(cdr ee)))
     (setq x1 (car xy1))
     (setq y1 (car(cdr xy1)))
     (setq a(list x1 y1 0))
     (setq aa(list x1 y1))
     (setq ang nil)
     (while (= ang nil)
       (setq ang (getangle aa "Select Second Point:"))
     )
     (princ (strcat "\nInput elev<" (rtos elev0) ">"))
     (setq ELEV1 (getreal))
     (if (not elev1) (setq elev1 elev0))
     (setq ang (* ang 57.2958))
     (setq txt (itoa (fix elev1)))
     (command "layer" "m" "9121-SYM""")
     (command "text" "j" "ml" a (* bili 0.002) ang txt)
     (princ)
  )
(defun c:zb1()
     (command "layer" "m" "zb""")
     (while (= bili nil)
       (setq bili (getreal "\n输入成图比例尺分母 :"))    
     )
     (setq tf5 (getstring "\n是50×50的图幅吗? 输入Y或N :"))
     (setq xxx 0.003)
     (setq yyy 0.0018)
     (setq hv "v") 
     (setq dh 0)
     (setq daihao (getstring "\有带号吗? 输入Y或N :"))
     (if (= daihao "y") 
         (setq dh (getreal "\n输入带号 :"))
     )    
     (setq xybl (getpoint "\n输入图幅在CAD中的西南角坐标y,x :"))
     (setq hv (getstring "\n图幅是横向<H>或是纵向<V>? :"))
     (setq y0 (+ (car xybl) (* dh 1e6)))
     (setq x0 (cadr xybl))
     (setq ybl (car xybl))
     (setq xbl (cadr xybl))
     (setq lo 1)
     (setq bl 1)
     (setq cs 0.4)
     (if (= tf5 "y") (setq cs 0.5))
     (if (< bili 1000) (setq bl 2))
     (while (<= lo 4)
       (setq cx 1)
       (setq cy 1)
       (if (or (= lo 1) (= lo 4)) (setq cx 0)) 
       (if (or (= lo 2) (= lo 1)) (setq cy 0))
       (if (= hv "v") (progn
           (setq xz (+ (* (* 0.5 cx) bili) x0))
           (setq yz (+ (* (* cs cy) bili) y0))
           (setq y (+ (* (* 0.5 cx) bili) xbl))
           (setq x (+ (* (* cs cy) bili) ybl))
           )
       )
       (if (= hv "h") (progn
           (setq xz (+ (* (* cs cx) bili) x0))
           (setq yz (+ (* (* 0.5 cy) bili) y0))
           (setq y (+ (* (* cs cx) bili) xbl))
           (setq x (+ (* (* 0.5 cy) bili) ybl))
           )
        )
        (setq xz (fix xz))
        (setq yz (fix yz))
        (setq xz (itoa xz)) 
        (setq yz (itoa yz))
        (setq xz1 " ")
        (setq yz1 " ")
        (setq xln (strlen xz))
        (setq yln (strlen yz))
        (if ( > xln 5) ( progn 
            (setq xz1 (substr xz 1 (- xln 5))) 
            (setq xz2 (substr xz (- xln 4) 2))
            (setq xz3 (substr xz (- xln 2) bl))
            ) ;end progn else 
                ( progn 
                  (setq xz2 (substr xz 1 (- xln 3)))
                  (setq xz3 (substr xz (- xln 2) bl))
               )
        )
        (setq xz2 (strcat xz2 ))
        (if ( > yln 5) ( progn 
            (setq yz1 (substr yz 1 (- yln 5))) 
            (setq yz2 (substr yz (- yln 4) 2))
            (setq yz3 (substr yz (- yln 2) bl))
            ); end progn else  
            ( progn 
                  (setq yz2 (substr yz 1 (- yln 3)))
                  (setq yz3 (substr yz (- yln 2) bl))
               )
        )
        (setq yz2 (strcat yz2 ))
        (setq x1 (- x (* bili (+ 0.0042 (* 0.00135 (strlen yz1)))))) 
        (setq x2 (- x (* bili 0.0042)))
        (setq x3 (- x (* bili (+ (* 0.00225 (- (strlen xz2) 1)) (* 0.00135 (strlen xz1))))))
        (setq x3 (+ x3 (* bili 0.0001)))
        (setq x4 (- x (* bili (* 0.00225 (- (strlen xz2) 1)))))
        (if ( or (= lo 3) (= lo 4)) ( progn
            (setq x3 (+ x (* bili 0.0002)))         
            (setq x3 (+ x3 (* bili 0.0001)))
            (setq x4 (+ x (* bili (+ (* (strlen xz1) 0.00135) 0.0002))))
            )
        )
        (setq yy 0.012)
        (if (> bili 5000) (setq yy 0.008))
        (setq y1 (- y (* bili (- yy 0.003))))
        (setq y2 (- y (* bili (- yy 0.0024))))
        (setq y3 (+ y (* bili 0.0027)))
        (setq y4 (+ y (* bili 0.0021)))
        (if (or ( = lo 2) (= lo 3)) (progn
            (setq y1 (+ y (* bili (- yy 0.0018))))
            (setq y2 (+ y (* bili (- yy 0.0024))))
            )
        )
        (setq pylx 0.0004)
        (setq pyld 0.0009)
        (if (or (= lo 1) (= lo 2)) (progn 
            (setq pylx 0)
            (setq pyld 0.0004)
            )
        )
        (setq xy1 (list (+ x1 40) y1))
        (setq xy2 (list (+ x2 40) y2)) 
        (if (or (= lo 1) (= lo 2)) (progn
            (setq xy3 (list (- (- x3 (* pylx bili)) 20) y3))
            (setq xy4 (list (- (- x4 (* pyld bili)) 20) y4))
            )
        )
        (if (or (= lo 3) (= lo 4)) (progn
            (setq xy3 (list (+ (- x3 (* pylx bili)) 10) y3))
            (setq xy4 (list (+ (- x4 (* pyld bili)) 10) y4))
            )
        )

        (command "text" "j" "ml" xy1 (* bili yyy) 0 yz1) 
        (command "text" "j" "ml" xy2 (* bili xxx) 0 yz2)
        (command "text" "j" "ml" xy3 (* bili yyy) 0 xz1) 
        (command "text" "j" "ml" xy4 (* bili xxx) 0 xz2)
        (setq lo (+ lo 1))
      )
      (setq loop "y")
      (setq zjg 3)
      (if (= tf5 "y") (setq zjg 4))
      (while (and (> bili 5000) (= loop "y"))
             (setq lo 1)          
             (setq cx10 (* bili 0.1))
             (if (= hv "v") (progn
                 (setq zx 4)
                 (setq zy zjg)
                 )
             )
             (if (= hv "h") (progn
                 (setq zx zjg)
                 (setq zy 4)
                 )
             )
             (while (<= lo zy)
                (setq yz5 (+ y0 (* cx10 lo)))
                (setq x (- (+ ybl (* cx10 lo)) 0))
                (setq yz5 (fix yz5))
                (setq yz5 (itoa yz5))
                (setq ly (strlen yz5))
                (setq y1 (substr yz5 (- ly 4) 2))
                (setq y2 (substr yz5 (- ly 2) 1))
                (setq yz (strcat y1 ))
                (setq yx (- xbl 50.5)) 
                (setq ys (+ xbl (+ 50.5 (* cx10 (+ zx 1)))))
                (setq y10 (list x yx))
                (setq y9 (list x ys))
                (command "text" "j" "ml" y10 (* bili xxx) 0 yz) 
                (command "text" "j" "ml" y9 (* bili xxx) 0 yz) 
                (setq lo (+ lo 1))
             )
             (setq lo 1)
             (while (<= lo zx)
                (setq xz5 (+ x0 (* cx10 lo)))
                (setq y (+ (+ xbl (* cx10 lo)) 20.5))
                (setq xz5 (fix xz5))
                (setq xz5 (itoa xz5))
                (setq ly (strlen xz5))
                (setq y1 (substr xz5 (- ly 4) 2))
                (setq y2 (substr xz5 (- ly 2) 1))
                (setq xz (strcat y1 ))
                (setq xl (- ybl 59)) 
                (setq xr (+ ybl (+ 6 (* cx10 (+ zy 1)))))
                (setq x10 (list xl y))
                (setq x9 (list xr y))
                (command "text" "j" "ml" x10 (* bili xxx) 0 xz) 
                (command "text" "j" "ml" x9 (* bili xxx) 0 xz) 
                (setq lo (+ lo 1))
             )
             (setq loop "n")
      )
      (princ)
)
(defun c:posd();展地形点
  (setq f (strcase(getstring "\n输入文件名:")))
  (if ( = (findfile f) nil)
     (progn 
        (print "Bad file name !")
        (quit)
     )
     (progn
        (setq a (open f "r"))
     )
  )
  (setq BILICHI (getreal "输入成图比例尺:"))
  (setq ws (getint"高程点位数:"))
  (setq c (read-line a)) 
  (while (/= c nil)  
    (progn
       (setq L (strlen c))
       (SETQ CN 1)
       (SETQ CM 1)
       (SETQ D NIL)
       (while (< cn L)
           (if(= (substr c cn 1) ",")
             (PROGN 
               (if (= cm 1) (setq c1 cn))  
               (if (= cm 2) (setq c2 cn))  
               (if (= cm 3) (setq c3 cn))  
               (if (= cm 4) (setq c4 cn))  
               (SETQ CM (+ CM 1))
             )
           )
           (SETQ CN (+ CN 1))
       )
       (setq pn (substr c 1 (- c1 1)))
       (setq x  (atof(substr c (+ c1 1) (- c2 1))))
       (setq y  (atof(substr c (+ c2 1) (- c3 1))))
       (setq z  (atof(substr c (+ c3 1) l)))
       (setq zz  ( atof(substr c (+ c3 1) l)))
       (if (= 1 ws) (setq zz4 (* zz  10)))
       (if (= 2 ws) (setq zz4 (* zz  100)))
       (setq zz5  (itoa(fix zz4)))
        (setq cd2 (strlen zz5))
       (setq zz1 (substr zz5 1 (- cd2 ws)))
       (setq zz2  (substr zz5 (+ (- cd2  ws) 1)  ws))
       (setq zz6 (strcat zz1 "." zz2))
       (setq xyz (list y x z))
       (command "layer" "m" "dxd" "c" "7""""")
       (command "insert" "c:/maped/lib/aa" xyz bilichi ""0)
       (setq yy (+ y (* bilichi 0.0003)))
       (setq xyzc (list (+ yy (* bilichi 0.0015 )) x z))
       (command "text" "j" "ml" xyzc (* bilichi 0.002)"0" zz6)
       (setq xyzz (list (+ yy (* bilichi 0.0015 )) (- x (* bilichi 0.003)) z))
       (command "layer" "m" "dm" "c" "3""""")
       (command "text" "j" "ml" xyzz (* bilichi 0.002)"0" pn)
        )         
  (setq c (read-line a)) 
  )
 (PRIN1)
)

(defun c:hdm();展断面点
  (setq f (strcase(getstring "\n输入文件名:")))
  (if ( = (findfile f) nil)
     (progn 
        (print "Bad file name !")
        (quit)
     )
     (progn
        (setq a (open f "r"))
     )
  )
  (setq bilichi (getint "输入横比例尺:"))
  (setq biliv (getint "输入纵比例尺:"))  
  (setq kk (/ bilichi biliv))
  (setq ws (getint"高程点位数:"))
  (setq c (read-line a)) 
  (while (/= c nil)  
    (progn
       (setq L (strlen c))
       (SETQ CN 1)
       (SETQ CM 1)
       (SETQ D NIL)
       (while (< cn L)
           (if(= (substr c cn 1) ",")
             (PROGN 
               (if (= cm 1) (setq c1 cn))  
               (if (= cm 2) (setq c2 cn))  
               (if (= cm 3) (setq c3 cn))  
               (if (= cm 4) (setq c4 cn))  
               (SETQ CM (+ CM 1))
             )
           )
           (SETQ CN (+ CN 1))
       )
       (setq pn (substr c 1 (- c1 1)))
       (setq x  (atof(substr c (+ c1 1) (- c2 1))))
       (setq y  (atof(substr c (+ c2 1) (- c3 1))))
       (setq z  (atof(substr c (+ c3 1) l)))
       (setq zz  ( atof(substr c (+ c3 1) l)))
       (if (= 1 ws) (setq zz4 (* zz  10)))
       (if (= 2 ws) (setq zz4 (* zz  100)))
       (setq zz5  (itoa(fix zz4)))
        (setq cd2 (strlen zz5))
       (setq zz1 (substr zz5 1 (- cd2 ws)))
       (setq zz2  (substr zz5 (+ (- cd2  ws) 1)  ws))
       (setq zz6 (strcat zz1 "." zz2))
       (setq yyy (* kk y))
       (setq xyz (list x yyy z))
       (command "layer" "m" "dxd" "c" "5""""")
       (command "insert" "c:/maped/lib/p2" xyz  bilichi ""0)
       (setq yy (+ yyy (* bilichi 0.0003)))
       (setq xyzc (list x (+ yyy (* bilichi 0.0015 )) z))
       (command "layer" "m" "dm" "c" "7""""")
       (command "text" "j" "ml" xyzc (* bilichi 0.002)"0" pn)
      )         
  (setq c (read-line a)) 
  )
 (PRIN1)
)
(defun c:zdm();展断面点
  (setq f (strcase(getstring "\n输入文件名:")))
  (if ( = (findfile f) nil)
     (progn 
        (print "Bad file name !")
        (quit)
     )
     (progn
        (setq a (open f "r"))
     )
  )
  (setq bilichi (getint "输入横比例尺:"))
  (setq biliv (getint "输入纵比例尺:")) 
  (setq qsg (getint "输入起始高程:"))  
  (setq kk (/ bilichi biliv))
  (setq qsgg (* kk qsg))
  (setq ws (getint"高程点位数:"))
  (setq c (read-line a)) 
  (while (/= c nil)  
    (progn
       (setq L (strlen c))
       (SETQ CN 1)
       (SETQ CM 1)
       (SETQ D NIL)
       (while (< cn L)
           (if(= (substr c cn 1) ",")
             (PROGN 
               (if (= cm 1) (setq c1 cn))  
               (if (= cm 2) (setq c2 cn))  
               (if (= cm 3) (setq c3 cn))  
               (if (= cm 4) (setq c4 cn))  
               (SETQ CM (+ CM 1))
             )
           )
           (SETQ CN (+ CN 1))
       )
       (setq pn (substr c 1 (- c1 1)))
       (setq x  (atof(substr c (+ c1 1) (- c2 1))))
       (setq y  (atof(substr c (+ c2 1) (- c3 1))))
       (setq z  (atof(substr c (+ c3 1) l)))
       (setq zz  ( atof(substr c (+ c3 1) l)))
       (if (= 1 ws) (setq zz4 (* y  10)))
       (if (= 2 ws) (setq zz4 (* y  100)))
       (setq zz5  (itoa(fix zz4)))
        (setq cd2 (strlen zz5))
       (setq zz1 (substr zz5 1 (- cd2 ws)))
       (setq zz2  (substr zz5 (+ (- cd2  ws) 1)  ws))
       (setq zz6 (strcat zz1 "." zz2))
       (setq yyy (* kk y))
       (setq xyz (list x yyy z))
       (command "layer" "m" "dxd" "c" "5""""")
       (command "insert" "c:/maped/lib/p2" xyz  bilichi ""0)
       (setq yy (+ yyy (* bilichi 0.0003)))
       (setq xyzc (list x (+ yyy (* bilichi 0.0015 )) z))
       (command "layer" "m" "dm" "c" "7""""")
       (command "text" "j" "ml" xyzc (* bilichi 0.002)"0" pn)
       (setq x99 (list x (+ qsgg (* (- 0 0.035) bilichi))))
       (setq y99 (list x (+ qsgg (* (- 0 0.0345) bilichi))))
       (command "line" x99 y99 "")
       (setq x99 (list x (+ qsgg (* (- 0 0.0195) bilichi))))
       (setq y99 (list x (+ qsgg (* (- 0 0.0205) bilichi))))
       (command "line" x99 y99 "")
       (setq x99 (list x (+ qsgg (* (- 0 0.0105) bilichi))))
       (setq y99 (list x (+ qsgg (* (- 0 0.010) bilichi))))
       (command "line" x99 y99 "")
       (setq y99 (list x (+ qsgg (* (- 0 0.0335) bilichi))))
       (command "text" "j" "ml" y99 (* bilichi 0.003)"90" zz6)
       (setq y99 (list x (+ qsgg (* (- 0 0.0185) bilichi))))
       (command "text" "j" "ml" y99 (* bilichi 0.003)"90" pn)
      )         
  (setq c (read-line a)) 
  )
 (PRIN1)
)
(defun c:fft();展地形点
  (setq f (strcase(getstring "\n输入文件名:")))
  (if ( = (findfile f) nil)
     (progn 
        (print "Bad file name !")
        (quit)
     )
     (progn
        (setq a (open f "r"))
     )
  )
  (setq BILICHI (getreal "输入成图比例尺:"))
  (setq ws (getint"高程点位数:"))
  (setq c (read-line a)) 
  (while (/= c nil)  
    (progn
       (setq L (strlen c))
       (SETQ CN 1)
       (SETQ CM 1)
       (SETQ D NIL)
       (while (< cn L)
           (if(= (substr c cn 1) ",")
             (PROGN 
               (if (= cm 1) (setq c1 cn))  
               (if (= cm 2) (setq c2 cn))  
               (if (= cm 3) (setq c3 cn))  
               (if (= cm 4) (setq c4 cn))  
               (SETQ CM (+ CM 1))
             )
           )
           (SETQ CN (+ CN 1))
       )
       (setq pn (substr c 1 (- c1 1)))
       (setq x  (atof(substr c (+ c1 1) (- c2 1))))
       (setq y  (atof(substr c (+ c2 1) (- c3 1))))
       (setq z  (atof(substr c (+ c3 1) l)))
       (setq zz  ( atof(substr c (+ c3 1) l)))
       (if (= 1 ws) (setq zz4 (* zz  10)))
       (if (= 2 ws) (setq zz4 (* zz  100)))
       (setq zz5  (itoa(fix zz4)))
        (setq cd2 (strlen zz5))
       (setq zz1 (substr zz5 1 (- cd2 ws)))
       (setq zz2  (substr zz5 (+ (- cd2  ws) 1)  ws))
       (setq zz6 (strcat zz1 "." zz2))
       (setq xyz (list y x z))
       (command "layer" "m" "dxd" "c" "7""""")
       (command "insert" "c:/maped/lib/p2" xyz bilichi ""0)
       (setq yy (+ y (* bilichi 0.0003)))
       (setq xyzc (list (+ yy (* bilichi 0.0015 )) x z))
       (command "text" "j" "ml" xyzc (* bilichi 0.002)"0" pn)
       (setq xyzz (list (+ yy (* bilichi 0.0015 )) (- x (* bilichi 0.003)) z))
       (command "layer" "m" "dm" "c" "3""""")
       )         
  (setq c (read-line a)) 
  )
 (PRIN1)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;