Tools/代码/LSP/GB512/Gb-512/GB-512.lsp

  (command "_menuunload" "GB-512")
  (command "_menuload" "GB-512")
  (menucmd "p15=+GB-512.pop1")
  (setvar "cmdecho" 0);;;关闭命令行回显功能
  (setvar "osmode" 0);关闭捕捉
  (setq wwh 8888)            
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:edPLnElve()
;(princ "\n选择曲线:\n")
(setq enedBreak (entsel "选择一根曲线:"))
(if (/= enedBreak nil)
(progn
(setq Myen (car enedBreak))
(setq Med (entget myen))
(setq Mxyz (assoc 10 Med))
(setq Myz (nth 3 Mxyz))
(princ "\n曲线原来的值为: ")
(princ Myz)
(princ "\n")
(setq Newz (getreal "输入曲线的值:"))
(if (/= Newz nil)
(command "change" myen "" "p" "e" newz "")
)
))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Joinzobao(en)
(SETVAR "CMDECHO" 0)
(setq lt nil)
(setq enlist nil)
(setq ed (entget en))
(SETQ D70 (CDR (ASSOC 70 ED)))
(setq en1 (entnext en))
(setq ed1 (entget en1))
(setq pp (cdr (assoc 0 ed1)))
(if (= pp "VERTEX")
(progn
(setq pt1 (assoc 10 ed1))
(if (/= pt1 nil)
(progn
(setq ptx (nth 1 pt1))
(setq pty (nth 2 pt1))
(setq ptz (nth 3 pt1))
(setq pt (list ptx pty ptz))
))
(setq lt (cons pt lt))
(setq enlist (cons en1 enlist))
(while (/= pp "SEQEND")
 (progn
    (setq en1 (entnext en1))
    (setq ed1 (entget en1))
    (setq pp (cdr (assoc 0 ed1)))
    (setq pt1 (assoc 10 ed1))
	(if (/= pt1 nil)
	(progn
	(setq ptx (nth 1 pt1))
	(setq pty (nth 2 pt1))
        (setq ptz (nth 3 pt1))
        (setq pt (list ptx pty ptz))
	))
    (setq lt (cons pt lt))
    (setq enlist (cons en1 enlist))
 )
)
(setq lt (cdr lt))
(setq enlist (cdr enlist))
(IF (OR (= D70 1) (= D70 9))
(PROGN
   (SETQ LT (CONS (LAST LT) LT))
))
(setq lt (reverse lt))
(setq enlist (reverse enlist))
)
(progn
(princ "SORRY! NOT 3DPOLYLINE use <gx>\n")
(SETQ LT NIL)
(redraw en 4)
(quit)
))
)
;;连接2条3dpolyline;;coord为LJ的子程序
(defun coord(en / ed)
(setq ee (entsel "\n请选择要连接的线:"))
(setq en (car ee))
(setq ed (enTGET en))
(print ed)
(setq la (cdr (assoc 8 ed)))
(setq pp (cdr (assoc 0 ed)))
(if (/= pp "LINE")
(progn 
(setq la (cdr (assoc 8 ed)))
(setq c38 (assoc 38 ed))
(if (eq c38 nil)
(progn
(setq en1 (entnext en))
(setq ed1 (entget en1))
(setq pp (cdr (assoc 0 ed1)))

(setq pt1 (assoc 10 ed1))
(if (/= pt1 nil)
(progn
(setq pt (cdr pt1))
))
(setq lt (list pt))
(while (/= pp "SEQEND")
 (progn
    (setq en1 (entnext en1))
	(setq ed1 (entget en1))
    (setq pp (cdr (assoc 0 ed1)))
    (setq pt1 (assoc 10 ed1))
	(if (/= pt1 nil)
	(progn
	 (setq pt (cdr pt1))
	))
    (setq lt (cons pt lt))
 )
)
(setq lt (cdr lt))
); not lwpolyline
(progn
  (print "aaa")
  (setq ev38 (cdr c38))
  (setq len (length ed))
  (setq len (- len 3))
  (setq j 0)
  (setq c10 (car (nth j ed)))
  (while (/= c10 10)
  (progn 
  (setq j (+ 1 j))
  (setq c10 (car (nth j ed)))
  ))
  (setq lt (list (list 0 0 0)))
  (while (< j len)
  (progn
    (setq lpt1 (cdr (nth j ed)))
    (setq lptx (nth 0 lpt1))
    (setq lpty (nth 1 lpt1))
    (setq lpt (list lptx lpty ev38))
    (setq lt (cons lpt lt))
    (setq j (+ j 4))
  )) 
(setq lt (reverse lt))
(setq lt (cdr lt))
)); is lwpolyline

) ; not line
(progn

 (setq lip1 (cdr (assoc 10 ed)))
 (setq lt (list lip1))
(setq lip2 (cdr (assoc 11 ed)))
(setq lt (cons lip2 lt))
))  ; line

(setq pot (cadr ee))
(setq edd ed)
(setq lla la)
(setq e en)
(setq lt lt)

;(entdel en)
)

连接2条3dpolyline，LJ为主程序;;coord为LJ的子程序
(defun c:lj1()
(setq lt1 (coord en))
(setq e1 e)
(setq la1 lla)
(setq et1 edd)
(setq pot1 pot)
(setq lt1 (reverse lt1))
(setq color1 (cdr c66))
;(setq c62 (assoc 62 ed))
;(setq cc62 (cons 62 3))
;(setq color1 (cdr c62))
;(setq ed (subst cc62 c62 ed))
;(entmod ed)
(command "change" e1 "" "P" "c" "3" "")
;_______________
(setq pss1 (car lt1))
(setq ps1 (list (nth 0 pss1) (nth 1 pss1)))
(setq pee1 (last lt1))
(setq pe1 (list (nth 0 pee1) (nth 1 pee1)))
(setq pot1 (list (nth 0 pot1) (nth 1 pot1)))
(setq ds1 (distance ps1 pot1))
(setq de1 (distance pe1 pot1))
(if (> ds1 de1)
(progn
  (setq lt1 lt1)
 )
 (progn
   (setq lt1 (reverse lt1))
 ))
;________________
(setq lt2 (coord en))
(setq e2 e)
(setq la2 lla)
(setq et2 edd)
(setq pot2 pot)
(setq lt2 (reverse lt2))
(command "change" e2 "" "p" "c" 3 "")
;_________________
(setq pss2 (car lt2))
(setq ps2 (list (nth 0 pss2) (nth 1 pss2)))
(setq pee2 (last lt2))
(setq pe2 (list (nth 0 pee2) (nth 1 pee2)))
(setq pot2 (list (nth 0 pot2) (nth 1 pot2)))
(setq ds2 (distance ps2 pot2))
(setq de2 (distance pe2 pot2))
(if (< ds2 de2)
(progn
  (setq lt2 lt2)
 )
 (progn
   (setq lt2 (reverse lt2))
 ))
;_________________
(if (= la1 la2)
(progn
(setq lt (append lt1 lt2))
(setvar "clayer" la1)
(setq i 0)
(setq len (length lt))
(if (NOT (EQ e1 e2))
(progn
   (command "3dpoly")
   (while (< i len)
   (progn
      (setq pt (nth i lt))
      (command pt)
      (setq i (+ 1 i))
   ))
   (command "")
   (entdel e1)
   (entdel e2)
)
(progn
   (prompt "\nSORRY! 你选择了同一条线!!!!")
   (print)
))
)
(progn
   (prompt "\nSORRY! 你选择的不是同一层的线!!!!")
   (PRINT)
))
;(command "change" "l" "" "p" "c" color1 "")
)
(defun c:mplnjoin()
(setq Ssent nil)
(setq Ppent nil)
(setq e1 "xxx")
(while (/= e1 nil)
(progn
(print)
(setq E1 (entsel "选择第一根线[右键结束]:"))
(if (/= e1 nil)
(progn
(setq ek1 (car e1))
(setq p1 (cadr e1))
(REDRAW Ek1 3)
(print)
(SETQ E2 (ENTSEL "选择第二根线:"))
(if (/= e2 nil)
(progn
(setq ek2 (car e2))
(setq p2 (cadr e2))

(setq ssent (cons ek1 ssent))
(setq ssent (cons ek2 ssent))
(setq Ppent (cons p1 PPent))
(setq Ppent (cons p2 PPent))
))
))
))
(setq ssLen (length ssent))
(setq ssn 0)
(while (< ssn sslen)
(progn
(setq ek1 (nth ssn ssent))
(setq p1 (nth ssn PPent))
(setq ssn (+ 1 ssn))
(setq ek2 (nth ssn Ssent))
(setq p2 (nth ssn Ppent))
(setq ssn (+ 1 ssn))
(if (= ek1 ek2)
(progn
(command "pedit" ek1 "c" "x" "")
)
(progn
(Joinzobao ek1)
(setq ltk1 lt)
(setq enlist1 enlist)
(setq en1z ptz)
(Joinzobao ek2)
(setq enlist2 enlist)
(setq ltk2 lt)
(setq en2z ptz)


(if (/= en1z en2z)
(progn
(princ "\n不能连接:高程值不相等\n")
)
(progn
(setq pk11 (nth 0 ltk1))
(setq pk12 (nth (- (length ltk1) 1) ltk1))
(setq pk21 (nth 0 ltk2))
(setq pk22 (nth (- (length ltk2) 1) ltk2))
(setq d11 (distance p1 pk11))
(setq d12 (distance p1 pk12))
(setq d21 (distance p2 pk21))
(setq d22 (distance p2 pk22))
(if (< d11 d12)
(progn (setq pk1 pk11) (setq enk1 (nth 0 enlist1)))
(progn (setq pk1 pk12) (setq enk1 (nth (- (length enlist1) 1) enlist1)))
)
(if (< d21 d22)
(progn (setq pk2 pk21) (setq enk2 (nth 0 enlist2)))
(progn (setq pk2 pk22) (setq enk2 (nth (- (length enlist2) 1) enlist2)))
)
(setq pt1x (nth 0 pk1))
(setq pt1y (nth 1 pk1))
(setq pt1z (nth 2 pk1))
(setq pt2x (nth 0 pk2))
(setq pt2y (nth 1 pk2))
(setq pt2z (nth 2 pk2))
(if (= pt1z pt2z)
(progn
(setq ptzdx (/ (+ pt1x pt2x) 2))
(setq ptzdy (/ (+ pt1y pt2y) 2))
(setq Ptzd (list ptzdx ptzdy pt1z))

(setq edk (entget enk1))
(setq c10n (cons 10 ptzd))
(setq c10 (assoc 10 edk))
(setq edk (subst c10n c10 edk))
(entmod edk)
(entupd enk1)

(setq edk (entget enk2))
(setq c10n (cons 10 ptzd))
(setq c10 (assoc 10 edk))
(setq edk (subst c10n c10 edk))
(entmod edk)
(entupd enk1)

(COMMAND "PEDIT" Ek1 "J" Ek1 Ek2 "" "")
));;
))
));;
))

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GB512blc(/ dcl_id1 done1)
  (setq dcl_id (load_dialog "GB-512.dcl")) 
  (if (not (new_dialog "GB512A" dcl_id))    	
    (exit)                                 	
  )   
 (setq wwblc "0")
 (action_tile "wwwblc" "(setq wwblc $value)")
 (setq done1(start_dialog))
 (if (= done1 1)
  (progn
   (if (= wwblc "0")(progn(setq wwblc 2000)(setq jc_dgj 2.0)))
   (if (= wwblc "1")(progn(setq wwblc 1000)(setq jc_dgj 1.0)))
   (if (= wwblc "2")(progn(setq wwblc 500)(setq jc_dgj 0.5)))
  )
  (progn
   (setq wwblc 2000)
   (setq jc_dgj 2.0)
  )
 )
   (unload_dialog dcl_id)
   (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
   (setq PI 3.141592654)
   (setq jieshi "1")
   (setq jcdx1 "0")
   (setq JC_jqx "8120")
   (setq JC_sqx "8110")
   (setq JC_gcd "8310")
;;;;;   (setq JC_dgj 2.0)
   (setvar "plinetype" 0)
)  
;;;;;;;;;;;;;;;;;;;;
(defun GB512SZ(/ dcl_id1 done2 a1 a2 aa1 aa2)
  (setq dcl_id (load_dialog "GB-512.dcl")) 
  (if (not (new_dialog "GB512B" dcl_id))    	
    (exit)                                 	
  )   
  (if (= jieshi "1")
   (progn
    (set_tile "jieshi0"  "0")
    (set_tile "jieshi1"  "1") )
   (progn
    (set_tile "jieshi0"  "1")
    (set_tile "jieshi1"  "0") )
  )   
  (if (= jcdx1 "1")
   (progn
    (set_tile "zdjcdx"  "0")
    (set_tile "sdjcdx"  "1") )
   (progn
    (set_tile "zdjcdx"  "1")
    (set_tile "sdjcdx"  "0") )
  )
 (set_tile "JCjqx" JC_jqx)
 (set_tile "JCsqx" JC_sqx)
 (set_tile "JCgcd" JC_gcd)
 (set_tile "JCdgj" (rtos JC_dgj))

 (action_tile "jieshi0" "(setq a1 $value)")
 (action_tile "jieshi1" "(setq a2 $value)")
 (action_tile "zdjcdx" "(setq aa1 $value)")
 (action_tile "sdjcdx" "(setq aa2 $value)")
 (action_tile "accept" "(box_txt)(done_dialog 1)") 

 (setq done2(start_dialog))
 (if (= done2 1)
  (progn
   (if (= a2 "1")(setq jieshi "1")(setq jieshi "0"))
   (if (= aa2 "1")(setq jcdx1 "1")(setq jcdx1 "0"))
 ))
   (unload_dialog dcl_id)
) 
;;;;;;;;;;;;;;;;;
(defun box_txt()
 (setq  JC_jqx (get_tile "JCjqx" ))
 (setq  JC_sqx (get_tile "JCsqx" ))
 (setq  JC_gcd (get_tile "JCgcd" ))
 (setq  JC_dgj (atof(get_tile "JCdgj" )))
)
(defun rcqx_def()
   (setq rcQxgs 4)
   (setq rcMapdis 1.0)
   (setq rcCs 3)
   (setq DrcCs0 1)
   (setq DrcCs1 1)
   (setq rcBlc 2000)
)
(defun MySetdlg(/ dcl_id )
(princ "\nGB-512[设置]:\n")
  (setq dcl_id (load_dialog "GB-512.dcl")) 
  (if (not (new_dialog "GB512c" dcl_id))    	
    (exit)                                 	
  )
 ;;;;;;
    (set_tile "RcMapDis" (rtos rcmapdis))
   (set_tile "RcBlc" (rtos rcblc))
   (set_tile "RcCs" (itoa rccs))
   (set_tile "DRcCs0" (itoa drccs0))
   (set_tile "DRcCs1" (itoa drccs1))
   (set_tile "RcQxgs" (itoa rcqxgs))
 ;;;;;;	
(action_tile "RcMapDis" "(setq srcmapdis $value)")
(action_tile "RcBlc" "(setq srcblc $value)")
(action_tile "RcCs" "(setq srccs $value)")
(action_tile "DRcCs0" "(setq sdrccs0 $value)")
(action_tile "DRcCs1" "(setq sdrccs1 $value)")
(action_tile "RcQxgs" "(setq srcqxgs $value)")
(setq What_next (start_dialog))
  (cond 
      ((= 1 what_next) (RcNewdata))
         )
  (unload_dialog dcl_id)        
(setq   srcqxgs nil
	srcblc nil
	srcmapdis nil
	srccs nil
	sdrccs0 nil
	sdrccs1 nil)
 (setq wwblc rcblc)	
  (princ)
)
(defun RcNewdata()
(if (/= srcqxgs nil) (setq rcQxgs (atoi srcqxgs)))
(if (/= srcmapdis nil) (setq rcmapdis (atof srcmapdis)))
(if (/= srccs nil) (setq RcCs (atoi srccs)))
(if (/= sdrccs0 nil) (setq dRcCs0 (atoi sdrccs0)))
(if (/= sdrccs1 nil) (setq dRcCs1 (atoi sdrccs1)))
(if (/= srcblc nil) (setq rcBlc (atof srcblc)))
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun Zaoqx(l1pt l2pt)
(setq l1tpx (nth 0 l1pt))
(setq l1tpy (nth 1 l1pt))
(setq l2tpx (nth 0 l2pt))
(setq l2tpy (nth 1 l2pt))
(setq qxnn 1)
(while (<= qxnn Rcqxgs)
(progn
(zzpt l1tpx l2tpx rcbs qxnn)
(setq Ltqxn (cons (list px py pz) Ltqxn))
(setq qxnn (+ qxnn 1))
))
(princ)
)
;;;;;;

(defun PlnLt(Plt n0)
(if (/= Plt nil)
(progn
(setq i (+ n0 rcqxgs))
(setq pf (nth n0 Plt))
(setq len (length Plt))
(command "pline" pf)
(while (< i len)
(progn
(setq pto (nth i Plt))
(command pto)
(setq i (+ rcqxgs i))
))
(command "")
))
;(setq plt nil)
(princ)
)
;;;;;;
(defun Myfree()
(setq Ltqxn nil)
(setq lt nil)
(setq lt1 nil)
(setq lt2 nil)
(setq en1 nil)
(setq en2 nil)
(setq rcbs nil)
(setq l1tpx nil)
(setq l2tpx nil)
(setq l1tpy nil)
(setq l2tpy nil)
(setq dx nil)
(setq dy nil)
(setq px nil)
(setq py nil)
(princ)
)
(defun zzpt(l1tpx l2tpx rcbs nn)
(setq dx (- l1tpx l2tpx))
(setq dy (- l1tpy l2tpy))
(setq px (- l1tpx (* dx rcbs nn)))
(setq py (- l1tpy (* dy rcbs nn)))
(setq pz (- p1z (* dgj nn)))
;;;;free
(princ)
)
;;;;;
(rcqx_def)
;;;;(Mysetdlg);;;;;;;;;;参数设置；；；；；；；；
;;;;;
(defun Rcqxzb(enLt p1 p2)
(SETVAR "CMDECHO" 0)
;;;;;
(setq EnLen (length enlt))
(setq n 0)
(setq min1 1000)
(setq min2 1000)
(while (< n Enlen)
(progn
(setq pt (nth n enlt))
(setq ds1 (distance pt p1))
(setq ds2 (distance pt p2))
(if (< ds1 min1)
(progn
(setq min1  ds1)
(setq the1 n) 
))
(if (< ds2 min2)
(progn
(setq min2  ds2)
(setq the2 n) 
))
(setq n (+ 1 n))
))
;;;;
(if (> the1 the2)
(progn
(setq addlt (reverse addlt))
(setq thetmp the1)
(setq the1 the2)
(setq the2 thetmp)
))
;;;;
(setq lt nil)
(setq n 0)
(while (< n Enlen)
(progn
;;
(if (and (>= n the1) (<= n the2))
(progn
(setq pt (nth n enlt))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq pt (list ptx pty))
(setq lt (cons pt lt))
)
)
;;
(setq n (+ 1 n))
))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun zobao(en p1 p2 dJx)
(SETVAR "CMDECHO" 0)
(setq IsJL 0)
(setq lt nil)
(setq ed (entget en))
(SETQ D70 (CDR (ASSOC 70 ED)))
(setq en1 (entnext en))
(setq ed1 (entget en1))
(setq pp (cdr (assoc 0 ed1)))
(if (= pp "VERTEX")
(progn
(if (< djx 0)
(progn
    (setq pt1 (assoc 10 ed1))
	(if (/= pt1 nil)
	(progn
	(setq ptx (nth 1 pt1))
	(setq pty (nth 2 pt1))
	(setq ptz (nth 3 pt1))
	(setq pt (list ptx pty))
	(setq lt (cons pt lt))
))
))
;;
(while (/= pp "SEQEND")
 (progn
    (setq en1 (entnext en1))
    (setq ed1 (entget en1))
    (setq pp (cdr (assoc 0 ed1)))
    (setq pt1 (assoc 10 ed1))
	(if (/= pt1 nil)
	(progn
	(setq ptx (nth 1 pt1))
	(setq pty (nth 2 pt1))
	(setq ptz (nth 3 pt1))
	(setq pt (list ptx pty))
	;;;;
(if (< djx 0)
(progn
(setq lt (cons pt lt))
)
(progn
(setq ds1 (distance pt p1))
(setq ds2 (distance pt p2))
;;(print "ds1")
;;(print ds1)
(if (= IsJL 0)
(progn
(if (< ds1 djx)
(setq IsJL 1)
)
(if (< ds2 djx)
(setq IsJL 2)
)
))

(if (and (= IsjL 1) (< ds2 djx))
(setq pp "SEQEND");exit
)
(if (and (= IsjL 2) (< ds1 djx))
(setq pp "SEQEND");exit
)

(if (or (= IsjL 1) (= IsjL 2))
(setq lt (cons pt lt))
)

));end 0
	));;if
 ));;while

(setq Mycando 1)
)
(progn
(prompt "SORRY! NOT 3DPOLYLINE")
(SETQ LT NIL)
(setq Mycantdo 0)
(redraw en 4)
(quit)
))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:myedclose()
(setq enedclose "xxx")
(while (/= enedclose nil)
(progn
(princ "\n闭合:\n")
(setq enedclose (entsel "选择一根线:"))
(if (/= enedclose nil)
(progn
(setq Myen (car enedclose))
(princ "\nedclose:")
(command "pedit" Myen "c" "" "")
(setq Myundoned (+ 1 Myundoned))
))
))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:myDelen()
(princ "\n选择删除目标:\n")
(setq en_delp1 (getpoint))
(if (/= en_delp1 nil)
(progn
(setq en_delp2 (getcorner en_delp1))
(if (/= en_delp2 nil)
(progn
(msg "1_x")
(setq delp1_x (nth 0 en_delp1))
(setq delp2_x (nth 0 en_delp2))
(if (> delp1_x delp2_x)
(progn
(setq del_ens (ssget "c" en_delp1 en_delp2))
)
(progn
(setq del_ens (ssget "w" en_delp1 en_delp2))
))
(msg "s_L")
(if (/= del_ens nil)
(progn
(setq Dels_Len (sslength del_ens))
(msg Dels_Len)
(setq n 0)
(while (< n Dels_Len)
(progn
(setq delen (ssname del_ens n))
(redraw delen 3)
(setq n (+ 1 n))
))
(princ "\n确定要删除![Y/N]\n")
(setq Key (getstring))
(if (not (eq (strcase key) "N"))
(progn
(setq drawLundo Dels_Len)
(setq n 0)
(while (< n Dels_Len)
(progn
(setq delen (ssname del_ens n))
(command "erase" delen "")
(setq n (+ 1 n))
))
)
(progn
(setq n 0)
(while (< n Dels_Len)
(progn
(setq delen (ssname del_ens n))
(redraw delen 4)
(setq n (+ 1 n))
))
));if "N" 
))))
))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:myedBreak()
(setq enedBreak "xxx")
(while (/= enedBreak nil)
(progn
(princ "\n打断:\n")
(setq enedBreak (entsel "选择一根线:"))
(if (/= enedBreak nil)
(progn
(setq Myen (car enedBreak))
(setq Mypt1 (cadr enedBreak))
(princ Mypt1)
(redraw myen 3)
(setq enedpt (getpoint "选择打断点:"))
(if (/= enedpt nil)
(progn
(command "break" Myen mypt1 enedpt "")
(setq Myundoned (+ 1 Myundoned))
))
))
))

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:myUndo()
(if (> drawLundo 0)
(progn
(setq undon 0)
(while (< undon drawLundo)
(progn
(command "undo" "")
(setq undon (+ undon 1))
))
(setq drawLundo -1)
)
(progn
(if (> Myundon 0)
(progn
(setq undon 0)
(while (< undon rcQxgs)
(progn
(command "undo" "")
(setq undon (+ undon 1))
))
(setq Myundon 0)
)
(progn
(if (> Myundoned 0)
(progn
(command "undo" "")
(setq Myundoned (- Myundoned 1))
)
(progn
(princ "\n确定还要后悔![Y/N]\n")
(setq Key (getstring))
(if (eq (strcase key) "Y")
(command "undo" "")
)))))))
(princ)
)

(defun c:chd()
(setq en (car (entsel "请选择一条要修改方向的线::\n")))
(setq ed (entget en))
(setq en1 (entnext en))
(setq ed1 (entget en1))
(setq pp (cdr (assoc 0 ed1)))
(setq pt (assoc 10 ed1))
(setq lt (list pt))
(while (/= pp "SEQEND")
 (progn
    (setq en1 (entnext en1))
    (setq ed1 (entget en1))
    (setq pp (cdr (assoc 0 ed1)))
    (setq pt (assoc 10 ed1))
    (setq lt (cons pt lt))
 )
)
(setq lt (cdr lt))
(setq ln (length lt))
(setq i 0)
(setq e1 (entnext en))
(setq d1 (entget e1))
(while (< i ln)
(progn
(setq ptt (nth i lt))
(setq pt (assoc 10 d1))
(setq d2 (subst ptt pt d1))
(entmod d2)
(setq e1 (entnext e1))
(setq d1 (entget e1))
(setq i (+ 1 i))
))
(command "redraw")
)
;;;;;;;;;;格网；；；
(defun c:gw()
(undo_begin)
  (command "layer" "m" "TK" "c" "7" "" "")
  (setq p1 (getpoint "\n 输入第1个点:"))
  (setq p2 (getpoint "\n 输入第2个点:"))
  (setq p3 (getpoint "\n 输入第3个点:"))
  (setq p4 (getpoint "\n 输入第4个点:"))
  (setq p1x (car p1))
  (setq p1y (cadr p1))
  (setq p2x (car p2))
  (setq p2y (cadr p2))
  (setq p3x (car p3))
  (setq p3y (cadr p3))
  (setq p4x (car p4))
  (setq p4y (cadr p4))
  (setq pxa (* 200 (fix (/ (max p1x p2x p3x p4x) 200))))
  (setq pxi (+ 200 (* 200 (fix (/ (min p1x p2x p3x p4x) 200)))))
  (setq pya (* 200 (fix (/ (max p1y p2y p3y p4y) 200))))
  (setq pyi (+ 200 (* 200 (fix (/ (min p1y p2y p3y p4y) 200)))))
  (setq ps (list pxi pyi 0))
  (setq n1 (/ (- pxa pxi) 200))
  (setq n2 (/ (- pya pyi) 200))
  (setq i 0)
  (while ( <= i n1)
  (progn
    (setq j 0)
  (while ( <= j n2)
  (progn
     (setq ptx (+ pxi (* i 200)))  
     (setq pty (+ pyi (* j 200)))
     (setq pt (list ptx pty 0))
     (command "insert" "cs" pt 2 2 0 "") 
     (setq j (+ 1 j))
     (princ "okokok")
   )  
   )
   (setq i (+ 1 i))
   )
   )
   (undo_end)
)

(defun c:3D-2D( / i flr ss slen ent ed la cla)
(undo_begin)
(setq flr '((-4 . "<AND") 
	    (0 . "POLYLINE") 
            (-4 . "<OR") (70 . 8) (70 . 9) (70 . 12) (70 . 13) (-4 . "OR>")
	  (-4 . "AND>")))
(princ "\n曲线编辑[三维转二维]")
(setq cla (getvar "clayer"))
(setq ss (ssget flr))
(if (/= ss nil)
(progn
(setq slen (sslength ss))
(setq i 0)
(while (< i slen)
(setq ent (ssname ss i))
(setq ed (entget ent))
(setq la (cdr (assoc 8 ed)))
(get-line-list ent)
(entdel ent)
(command "layer" "m" la "")
(Draw_Pln_lt line-list)
(setq i (+ 1 i))
)
))
(command "layer" "m" cla "")
(setvar "plinewid" 0)
(undo_end)
)
(defun Draw_Pln_lt(Plt / i pf len pto)
(if (/= Plt nil)
(progn
(setq i 0)
(setq pf (nth i Plt))
(setq len (length Plt))
(command "pline" pf)
(setq i 1)
(while (< i len)
(setq pto (nth i Plt))
(command pto)
(setq i (+ 1 i))
)
(command "")
))
)
;;;;;;高程点；；；
(defun c:smb()
(undo_begin)
(setq lla (getstring "输入层名:"))
(command "layer" "s" lla "" "")
(setq ss (ssget "x" (list (cons 8 lla))))
(setq len (sslength ss))
(setq i 0)
(while (< i len)
(progn
   (setq en (ssname ss i))
   (setq et (entget en))
   (setq pp (cdr (assoc 0 et)))
   (if (= pp "POINT")
   (progn
      (setq pt (cdr (assoc 10 et)))
	  (command "erase" en "")
;	  (command "DONUT" 0 1 pt "")
          (COMMAND "INSERT" "HP" PT 1 1 0)   
   )
   (PROGN
   (IF (= PP "INSERT")
   (PROGN
     (command "erase" en "")
    )
   )
   ))
   (setq i (+ 1 i))
)
)
(undo_end)
)

;;;;替换块；；；；
(defun c:chgsmb1()
(undo_begin)
 (if (= wwblc nil) (setq xl 4.0))
 (if (= wwblc 500) (setq xl 1.0))
 (if (= wwblc 1000) (setq xl 2.0))
 (if (= wwblc 2000) (setq xl 4.0))
 (print /n)
(setq lla (getstring "输入被替换块层名:"))
(setq dblock (getstring "输入新块名:"))
(setq newlay (getstring "输入替换后新层名:"))
;(setq xl (getreal "输入比列:"))
(command "layer" "s" lla "")
(setq lla (list '(0 . "insert") (cons 8 lla))) 
(setq ss (ssget "x" lla))
(setq len (sslength ss))
(setq i 0)
(while (< i len)
(progn
(print /ni)
   (setq en (ssname ss i))
   (setq et (entget en))
   (setq pp (cdr (assoc 0 et)))
   (if (= pp "INSERT")
   (progn
          (setq pt (cdr (assoc 10 et)))
	  (command "erase" en "")
	  (command "layer" "m" newlay "c" "4" "" "")
	  (command "insert" dblock pt xl xl "" "")
   ))
   (setq i (+ 1 i))
)
)
(undo_end)
)

;;;;;;点线；；；
(defun c:dx ()       ;点线
  (setq en (car(entsel "\n请选择线:")));
  (setq d1 (getdist "\n点距:"))
  (setq rad (getdist "\n点径:"))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
         (setq i 0)
         (setq d1 (* d1 (/ wwblc 1000)))
         (setq rad (* rad (/ wwblc 1000)))
         (setq D D1)
         (setq PC (nth i lt))
         (setq i (+ 1 I))
         (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
 			(command "donut" "0" rad am "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
		 );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
    ));IF LT IS NULL BLOCK
;(command "layer" "f" la "");根据需要选择此行
);endfunction
;;;;;;;;;;;;;;;;;;;;;;解释部分；；；;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;；；；；；
(defun ZuoBiao1 (en) ；提取Z值  
  (SETVAR "CMDECHO" 0)
  (setq lt nil)
  (setq D70 (CDR (ASSOC 70 ED)))
  (setq en1 (entnext en))
  (setq ed1 (entget en1))
  (setq pp (cdr (assoc 0 ed1)))
  (if (= pp "VERTEX")
    (progn
      (setq pt1 (assoc 10 ed1))
      (if (/= pt1 nil)
        (progn
          (setq ptx (nth 1 pt1))
          (setq pty (nth 2 pt1))
          (setq ptz (nth 3 pt1))
          (setq pt (list ptx pty ptz))
         );endprogn
       );endif
      (setq lt (cons pt lt))
      (while (/= pp "SEQEND")
        (progn
           (setq en1 (entnext en1))
           (setq ed1 (entget en1))
           (setq pp (cdr (assoc 0 ed1)))
           (setq pt1 (assoc 10 ed1))
           (if (/= pt1 nil)
	         (progn
	           (setq ptx (nth 1 pt1))
	           (setq pty (nth 2 pt1))
               (setq ptz (nth 3 pt1))
               (setq pt (list ptx pty ptz))
	         );endprogn
          );endif
          (setq lt (cons pt lt))
       );endprong
     );endwhile
     (setq lt (cdr lt))
     (IF (OR (= D70 1) (= D70 32))
        (PROGN
          (setq LT (CONS (LAST LT) LT))
        );endprogn
      );endif
     (setq lt (reverse lt))
  );endprogn
   (progn
        (prompt "SORRY! THERE IS NOT 3DPOLYLINE IN YOUR LAYER::\n")
        (setq LT NIL)
        (setq KEY (GETSTRING "GO! GO!<Y>:\n"))
        (redraw en 3)
    );endprogn
 );endif
);endfunction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;生成所需符号线

;;;;;;
(defun c:gxk ()   ;;改变所选线的线宽

  (prompt "\n改变所选线的线宽！")
  (setq en (car (entsel "\n选择需要改线宽的线:")))
  ;(setq sww (getint "\n输入比例(1.(1:500) 2.(1:1000) 3.(1:2000))<3>:"))
  (setq wid (getreal "\n输入新线宽(mm):"))

  (cond
      ((= wwblc nil) (setq sc 2.0))
      ((= wwblc 500)   (setq sc 0.5))
      ((= wwblc 1000)   (setq sc 1.0))
      ((= wwblc 2000)   (setq sc 2.0))
  );endcond
  (setq width (* wid sc))
  (command "pedit" en "w" width "")
;  (setq ed (entget en))
;  (setq la (cdr (assoc 8 ed)))
;  (setq lla (strcat la "_sym"))
;  (command "layer" "m" lla "c" "4" "" "")
;
;  (setq lt (get-line-list en))
;  (IF (/= LT NIL)
;     (PROGN
;       (setq i 0)
;       (setvar "PLINEWID" width) ;;;
;       (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;;以下为替换部分
;       (command "pline" pt)
;       (while (/= pt nil)
;           (setq i (+ 1 i))
;           (setq pt (nth i lt))
;           (command pt)
;       );endwhile
;      (command "")
;    );endprogn
;   );endif
;(command "erase" en "")
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
;(setvar "PLINEWID" 0)
);endfunction

;;;;;;
(defun c:gxkla ()   ;;改变所选层的线宽

  (prompt "\n改变所选层的线宽！")

  (setq s (getstring "\n选择需要改线宽的层名:"))
  ;(setq sww (getint "\n输入比例(1.(1:500) 2.(1:1000) 3.(1:2000))<3>:"))
  (setq wid (getreal "\n输入新线宽(mm):"))
  (setq s1 (cons '8   s))
  (setq s2 '(0 . "POLYLINE"))
  (setq s3 (list s1 s2))
  (setq ss (ssget "x" s3))
  (setq n (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  ;(setq ed (entget en))
  ;(setq la (cdr (assoc 8 ed)))
  ;(setq lla (strcat la "_sym"))
  ;(command "layer" "m" lla "c" "4" "" "")

  (cond
       ((= wwblc nil) (setq sc 2.0))
       ((= wwblc 500)   (setq sc 0.5))
       ((= wwblc 1000)   (setq sc 1.0))
       ((= wwblc 2000)   (setq sc 2.0))

   );endcond
  (setq width (* wid sc))

  (while (< t n)
     (command "pedit" en "w" width "") 
 ; (setq lt (get-line-list en))
 ; (IF (/= LT NIL)
 ;    (PROGN
 ;      (setq i 0)
 ;      (setvar "PLINEWID" width) ;;;
 ;      (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;;以下为替换部分
 ;      (command "pline" pt)
 ;      (while (/= pt nil)
 ;          (setq i (+ 1 i))
 ;          (setq pt (nth i lt))
 ;          (command pt)
 ;        );endwhile
 ;       (command "")
 ;    );endprogn
 ;  );endif
;(command "erase" en "")
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
  (setq t (+ 1 t))
  (setq en (ssname ss t))
 );endwhile(< t n)
;(setvar "PLINEWID" 0)
);endfunction

;;;;;;
(defun c:443b ()   ;;不依比例尺的围墙
(undo_begin)
(if (= jieshi "1")
 (PROGN
  (setq enss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2430"))))
  (if (= enss nil)(PROGN(print "找不到 2430 ！")(exit)))
  (setq len (sslength enss))
  (setq t 0)
  (setq en (ssname enss t))
 )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
  (setq len 1)
  (setq t 0)
  ));endif 
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (setq width (* 0.0003 wwblc))
  (setq wid_1 (* 0.0006 wwblc))
  (setq hei_1 (* (+ 0.00015 0.0006) wwblc))
  (setq d1 (* 0.01 wwblc))
  (setq d d1)
  (setvar "PLINEWID" width) ;;;
  (while (< t len)
    (setq lt (get-line-list en))
    (IF (/= LT NIL)
     (PROGN
       (setq i 0)
       (setvar "PLINEWID" width)
       (setq Pt (nth i lt))
       (command "pline" pt)
       (while (/= pt nil)
           (setq i (+ 1 i))
           (setq pt (nth i lt))
           (command pt)
         );endwhile
        (command "")
       );endprogn
     );endif
      (setq I 0)
      (setq pc (nth I lt))
      (setq I (+ 1 I))
      (setq dc (nth I lt))
	  (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
            (setvar "PLINEWID" wid_1)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) hei_1))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
         );endwhile
		(setq d (- d km))
		(setq pc dc)
        (setq i (+ 1 i))  
		(setq DC (nth i lt))
	  );endwhile 
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
  (setq t (+ 1 t))
  (if (= jieshi "1")(setq en (ssname enss t)))
 );endwhile(< t n)
(setvar "PLINEWID" 0)
(command "layer" "f" la "")
(undo_end)
);endfunction


;;;;;
(defun c:535 ()       ;打谷场,球场
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "3350"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
       (setq i 0)
       (setq d1 (* 0.0016 wwblc))
       (setq rad (* 0.0003 wwblc))
	   (setq D D1)
	   (setq PC (nth i lt))
	   (setq i (+ 1 I))
	   (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
       (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(command "donut" "0" rad am "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
		 );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
        (setq i (+ 1 i))  
		(setq dc (nth i lt))
	 );endwhile
    ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
);endwhile
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

;;;;;;;;;;;;;改变已跟计曲线及首曲线的线宽
(defun c:1011a ()   ;;首曲线 

   (setq width (* 0.00015 wwblc))
  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "8110"))))
  (setq n (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))

  (command "layer" "m" lla "c" "4" "" "")
   (while (< t n)

    (setq lt (ZuoBiao1 en))
    (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
	  (setvar "PLINEWID" width) ;;;
        (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (command "pline" pt)
        (while (/= pt nil)
           (setq i (+ 1 i))
           (setq pt (nth i lt))
           (command pt)
         );endwhile
        (command "")
     );endprogn
   );endif
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
  (setq t (+ 1 t))
    (setq en (ssname ss t))
 );endwhile(< t n)
(setvar "PLINEWID" 0)
(command "layer" "f" la "" );;根据需要选择此行
);endfunction



;;;
(defun c:1011b ()  ;;;;计曲线
 
 (setq width (* 0.0003 wwblc))
 (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "8120"))))
 (setq n (sslength ss))
 (setq t 0)
 (setq en (ssname ss t))

 (setq ed (entget en))
 (setq la (cdr (assoc 8 ed)))
 (setq lla (strcat la "_sym"))
 (command "layer" "m" lla "c" "4" "" "")
 (while (< t n)

 (setq lt (ZuoBiao1 en))
 (IF (/= LT NIL)
    (PROGN
      (setq i 0)
	  (setvar "PLINEWID" width) ;;;
      (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
      (command "pline" pt)
      (while (/= pt nil)
          (setq i (+ 1 i))
          (setq pt (nth i lt))
          (command pt)
       );endwhile
       (command "")
    );endprogn
 );endif
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
(setq t (+ 1 t))
(setq en (ssname ss t))
);endwhile(< t n)
(setvar "PLINEWID" 0)
(command "layer" "f" la "" );;根据需要选择此行
);endfunction

;;;;;
(defun c:831 ()    ;;单线渠831
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6310"))))
 )) 
 (setq width (* 0.0003 wwblc))
 (setq n (sslength SsSel))
 (setq t 0)
 (setq en (ssname SsSel t))
 (setq ed (entget en))
 (setq la (cdr (assoc 8 ed)))
 (setq lla (strcat la "_sym"))
 (command "layer" "m" lla "c" "4" "" "")
 (while (< t n)
    (setq lt (get-line-list en))
    (IF (/= LT NIL)
      (PROGN
        (setq i 0)
	    (setvar "PLINEWID" width) ;;;
        (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (command "pline" pt)
        (while (/= pt nil)
  	      (setq i (+ 1 i))
          (setq pt (nth i lt))
          (command pt)
         );endwhile
        (command "")
      );endprogn
    );endif
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
   (setq t (+ 1 t))
   (setq en (ssname SsSel t))
  );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "" );;根据需要选择此行
(undo_end)
);endfunction

;;;;;;
(defun c:gc ();高程点及注记

  (setvar "cmdecho" 0)
  (setvar "dimzin" 2)
  (setq n 1);注记小数位
  (setq dia (* 0.0004 wwblc))
  (setq hei_word (* 0.002 wwblc))
  (setq jiaju (* 0.0015 wwblc))
  (command "style" "gcd" "黑体" "" 0.8 "" "" "")
  (while
  (setq dot2d (getpoint "\n输入高程点位置:"))
  (setq dott (getpoint "\n输入注记起点:"))
  ;(setq dott (polar dot2d 0 jiaju))
  ;(setq dott (polar dott -90 (/ hei_word 2.0)))
  (setq dotz  (getreal "\n输入高程值:"))
  (setq dot   (list (car dot2d) (car (cdr dot2d)) dotz))
  (command "layer" "m" "8310" "" "")
  (command "insert" "hp" dot "" "" "")
  (setq dottext (list (car dott) (car (cdr dott)) dotz))
  ;(setq dottext dott)
  (setq zj (rtos dotz 2 1))
  (command "text" dottext hei_word "0" zj)
  (command "layer" "s" "0" "")
))

;;;;;;
(defun c:Bg ();比高点及注记

  (setvar "cmdecho" 0)
  (setvar "dimzin" 2)
  (setq n 1);注记小数位
  (setq dia (* 0.0004 wwblc))
  (setq hei_word (* 0.002 wwblc))
  (setq jiaju (* 0.0015 wwblc))
  (command "style" "gcd" "黑体" "" 0.8 "" "" "")
  (while
  (setq dot2d (getpoint "\n输入比高点位置:"))
  (setq dott (getpoint "\n输入注记起点:"))
  ;(setq dott (polar dot2d 0 jiaju))
  ;(setq dott (polar dott -90 (/ hei_word 2.0)))
  (setq dotz  (getreal "\n输入高程值:"))
  (setq dot   (list (car dot2d) (car (cdr dot2d)) dotz))
  (command "layer" "m" "8340" "" "")
  (command "insert" "hp" dot "" "" "")
  (setq dottext (list (car dott) (car (cdr dott)) dotz))
  ;(setq dottext dott)
  (setq zj (rtos dotz 2 1))
  (command "text" dottext hei_word "0" zj)
))


;;;;;;;;;; 
(defun jqx (endln / ename etype elist);跟踪后直接生成计曲线

  (setq width (* 0.0003 2000))	
  (setq ename (car endln))	
  (if ename	
      (setq elist (entget ename))	
      (princ "\nNo entity found ")	
  );end if ename	
  (if elist	
      (progn	
        (setq etype (cdr (assoc 0 elist)))	
        (if ( = etype "POLYLINE")
          (command "._pedit" ename "w" width "")	
          (princ "\nEntity is not a polyline ")	
         );end if etype	ends the if statement
      );end progn	
  );end if elist	
);end of function	

;;;;;;;;;; 
(defun sqx (endln / ename etype elist);跟踪后直接生成首曲线

  (setq width (* 0.00015 2000))	
  (setq ename (car endln))	
  (if ename	
     (setq elist (entget ename))	
     (princ "\nNo entity found ")	
  );end if ename	
  (if elist	
      (progn	
        (setq etype (cdr (assoc 0 elist)))	
        (if ( = etype "POLYLINE")	
          (command "._pedit" ename "w" width "")	
          (princ "\nEntity is not a polyline ")	
         );end if etype	ends the if statement
      );end progn	
  );end if elist	
);end of function	


(defun c:644 ()         ;内部道路644：虚线--实线1，空格1，线宽0.15     
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "4440"))))
 ))   	
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
         (setq i 0)
         (setq d1 (* 0.001 wwblc))
	     (setq d2 (* 0.001 wwblc))
         ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
         ;(setvar "PLINEWID" width) ;;;
         (setvar "PLINEWID" 0)
         (setq D D1)
	     (setq PC (nth i lt))
	     (setq i (+ 1 I))
	     (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	     (setq kk 1)
	     (WHILE (/= dc nil)
		    (setq km (distance pc dc))
            (setq ang (angle pc dc))
		      (while (>= km d)
			    (setq am (polar pc ang d))
                (if (= kk 1)
				  (progn(command "pline" pc am ""))
			    );endif
			    (setq km (- km d))
			    (if (= kk 1)
				  (progn(setq kk 2)
				  (setq d d2));else
				  (progn(setq kk 1)
                  (setq d d1));endprogn
			    );endif
			   (setq pc am)
		      );endwhile
		     (if (= kk 1)
			 (progn(command "pline" pc dc ""))
		     );endif

		     (setq d (- d km))
		     (setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
             (setq i (+ 1 i))  
             (setq DC (nth i lt))
	     );endwhile
	
     ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "" );根据需要选择此行
(undo_end)
);endfunction

;;;;;;;;;;
(defun c:414 ()         ;破坏房屋414，廊房：虚线--实线2，空格1，线宽0.15
(undo_begin)
 (if (= jieshi "1")
  (PROGN
  (setq ss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2140"))))
  (if (= ss nil)(PROGN(print "找不到 2140 ！")(exit)))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))
  )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
  (setq len 1)
  (setq t 0)
  ));endif
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
  (setq lt (get-line-list en))
    (IF (/= LT NIL)
      (PROGN
         (setq i 0)
         (setq d1 (* 0.002 2000));;注意这两行
	     (setq d2 (* 0.001 2000));;
         ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
         ;(setvar "PLINEWID" width);;;
         (setvar "PLINEWID" 0)
         (setq D D1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	    (setq kk 1)
	    (WHILE (/= dc nil)
		  (setq km (distance pc dc))
		  (setq ang (angle pc dc))
		  (while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		);endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
	     (setq DC (nth i lt))
	);endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (if (= jieshi "1")(setq en (ssname ss t)))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction
;;;;;
(defun c:811b()
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6113"))))
 ))
(if (/= sssel nil)(xsh SsSel)(print "没有找到 6113 ！"))
)
(defun c:812 ()   
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
   (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6121"))))
 ))      
(if (/= sssel nil)(xsh SsSel)(print "没有找到 6121 ！"))
)
(defun xsh(SsSel);时令河,高水界：虚线--实线3，空格1，线宽0.15
(undo_begin)
  (setvar "cmdecho" 0)
   (setq len (sslength SsSel))
   (setq t 0)
   (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.003 wwblc))
	    (setq d2 (* 0.001 wwblc))
         ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
         ;(setvar "PLINEWID" width);;;
         (setvar "PLINEWID" 0)
         (setq D D1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	 (setq kk 1)
	 (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		);endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
                  (setq i (+ 1 i))  
		(setq DC (nth i lt))
	);endwhile
    ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;;
(defun c:642a ()         ;依比例的乡村路642a--虚线--实线4，空格1,线宽0.2
(undo_begin)
  (setq en (car(entsel "请选择虚线边:")));绘虚线边
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (setq lt (get-line-list en))
  (IF (/= LT NIL)
     (PROGN
       (setq i 0)
       (setq d1 (* 0.004 wwblc))
       (setq d2 (* 0.001 wwblc))
       (setq width (* 0.0002 wwblc))      ;;;注意线宽 
       (setvar "PLINEWID" width);;;
       (setq D D1)
	   (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	(setq kk 1)
	(WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			 );endif
			(setq pc am)
		);endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	);endwhile
  ));IF LT IS NULL BLOCK
    (setq en (car (entsel "\n请选择实线边:")));绘实线边
    (setq ed (entget en))
    (setq la (cdr (assoc 8 ed)))
    (setq lla (strcat la "_sym"))
    (command "layer" "m" lla "c" "4" "" "")
    (setq lt (get-line-list en))
    (IF (/= LT NIL)
      (PROGN
        (setq i 0)
        (setvar "PLINEWID" width) ;;;
        (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (command "pline" pt)
        (while (/= pt nil)
          (setq i (+ 1 i))
          (setq pt (nth i lt))
          (command pt)
         );endwhile
         (command "")
      );endprogn
    );endif
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
(setvar "PLINEWID" 0)
;(command "layer" "f" la "" );;根据需要选择此行
(undo_end)
);endfunction

;;;;;;
(defun c:642b ();乡村路642b：不依比例--虚线--实线8，空格2，线宽0.3
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "4422"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
      (setq lt (get-line-list en))
      (IF (/= LT NIL)
       (PROGN
         (setq i 0)
         (setq d1 (* 0.008 wwblc))
         (setq d2 (* 0.002 wwblc))
         (setq width (* 0.0003 wwblc))      ;;;注意线宽 
         (setvar "PLINEWID" width);;;
         (setq D D1)
         (setq PC (nth i lt))
         (setq i (+ 1 I))
         (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	(setq kk 1)
	(WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
          );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	);endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;;
(defun c:643 ()         ;小路643：虚线--实线4，空格1，线宽0.3
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "4430"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	   (setq i 0)
        (setq d1 (* 0.004 wwblc))
	   (setq d2 (* 0.001 wwblc))
        (setq width (* 0.0003 wwblc))      ;;;注意线宽 
        (setvar "PLINEWID" width);;;
        (setq D D1)
	   (setq PC (nth i lt))
	   (setq i (+ 1 I))
        (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (setq kk 1)
	  (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;;
(defun c:1011c ()         ;间曲线1011c：虚线--实线6，空格1，线宽0.15
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8130"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
      (setq lt (ZuoBiao1 en))
      (IF (/= LT NIL)
        (PROGN
	      (setq i 0)
           (setq d1 (* 0.006 wwblc))
	      (setq d2 (* 0.001 wwblc))
           (setq width 0)      ;;;注意线宽 
           (setvar "PLINEWID" width);;;
           (setq D D1)
	      (setq PC (nth i lt))
	      (setq i (+ 1 I))
	      (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	    (setq kk 1)
	    (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2));endpron
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
       );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction


;;;;;;
(defun c:641 ()         ;大车路641：虚线边--实线8，虚线2，线宽0.2
(undo_begin)
  (setq en (car(entsel "请选择虚线边:")));绘虚线边
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (setq lt (get-line-list en))
  (IF (/= LT NIL)
     (PROGN
        (setq i 0)
        (setq d1 (* 0.008 wwblc))
        (setq d2 (* 0.002 wwblc))
        (setq width (* 0.0002 wwblc))      ;;;注意线宽 
        (setvar "PLINEWID" width);;;
        (setq D D1)
        (setq PC (nth i lt))
        (setq i (+ 1 I))
        (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	   (setq kk 1)
	 (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			 );endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		 );endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
             (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
    (setq en (car (entsel "\n请选择实线边:")))；绘实线边
    (setq ed (entget en))
    (setq la (cdr (assoc 8 ed)))
    (setq lla (strcat la "_sym"))
    (command "layer" "m" lla "c" "4" "" "")
    (setq lt (get-line-list en))
    (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
	    (setvar "PLINEWID" width) ;;;
         (setq Pt (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
         (command "pline" pt)
         (while (/= pt nil)
            (setq i (+ 1 i))
            (setq pt (nth i lt))
          (command pt)
          );endwhile
         (command "")
      );endprogn
    );endif	
));IF LT IS NULL BLOCK
(setvar "PLINEWID" 0)
;(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;;;;;;;;陡崖子程序
(defun dy (insertp angle)
 
   (setq ip insertp)
   (setq angl (+ 1.570796 angle))
   (setvar "PLINEWID" 0)
   
   (setq l1 (* 0.0015 wwblc))
   (setq l2 (* 0.001 wwblc))
   (setq l3 (* 0.0005 wwblc))
   (setq dis (* 0.001 wwblc))

    (setq ip1 (polar ip angl dis)
          ip2 (polar ip angl (* 2 dis))
          ip3 (polar ip angl (* 3 dis))
          ip4 (polar ip angl (* 4 dis))
     );endsetq

     (setq dis1 (polar ip1 (+ (/ (* PI 3.0) 2.0) angl) l1)
           dis2 (polar ip2 (+ (/ (* PI 3.0) 2.0) angl) l2)
           dis3 (polar ip3 (+ (/ (* PI 3.0) 2.0) angl) l3)
     );endsetq

     (command "pline" ip ip4 "")
     (command "pline" ip1 dis1 "")
     (command "pline" ip2 dis2 "")
     (command "pline" ip3 dis3 "")  

);endfunction


;;;;;
(defun c:1033b ()  ; 石质的陡崖1033b
 (undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8432"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (while (< t len)
    (setq ed (entget en))
    (setq la (cdr (assoc 8 ed)))
    (setq lla (strcat la "_sym"))
     (command "layer" "m" lla "c" "4" "" "")
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	   (setq i 0)
        (setq d1 (* 0.002 2000))
	   (setq S (* 0.001 2000))
        ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
        ;(setvar "PLINEWID" width);;;
        (setvar "PLINEWID" 0)
        (setq d d1)
	   (setq PC (nth i lt))
	   (setq i (+ 1 I))
	   (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(dy am ang)
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
           );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
 ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
);endwhile
(setvar "aunits" 0)
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction
;;;;;
(defun c:1033a ()  ; 土质的陡崖1033a
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8431"))))
 ))
  (setq len (sslength SsSel))
  (setq t 0)
(if (/= sssel nil)
 (progn
  (while (< t len)
   (setq en (ssname SsSel t)) 
   (a1033a_a en)
   (setq t (+ t 1))
  )
))
(setvar "aunits" 0)
(undo_end)
)
(defun a1033a_a (en)       ;将选定的曲线解释成坎状符号kan
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
        (setq d1 (* 0.002 wwblc))
	    (setq S (* 0.001 wwblc))
        ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
        ;(setvar "PLINEWID" width);;;
        ( setvar "PLINEWID" 0)
        (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
           );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
   ));IF LT IS NULL BLOCK
(setvar "PLINEWID" 0)
;(command "layer" "f" la "");根据需要选择此行
);endfunction
;;;;
(defun c:1161 ()       ;地类界1161
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "9610"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
         (setq i 0)
         (setq d1 (* 0.0016 wwblc))
         (setq rad (* 0.0003 wwblc))
         (setq D D1)
         (setq PC (nth i lt))
         (setq i (+ 1 I))
         (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(command "donut" "0" rad am "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
		 );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
    ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
);endwhile
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction
;;;;;
(defun c:1042a ()       ;未加固的陡坎1042a
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8521"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
        (setq d1 (* 0.002 wwblc))
	    (setq S (* 0.001 wwblc))
        ( setvar "PLINEWID" 0)
        (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
           );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
   ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

;;;;;
(defun c:1042b()       ;已加固的陡坎1042b
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8522"))))
 ))
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.004 wwblc))
	    (setq S (* 0.001 wwblc))
         (setq s1 (* 0.002 wwblc))
         (setq s2 (* 0.001 wwblc))
         (setq rad (* 0.0003 wwblc))
         ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
         ;(setvar "PLINEWID" width);;;
         (setvar "PLINEWID" 0)
         (setq d d1)
	   (setq PC (nth i lt))
	   (setq i (+ 1 I))
	   (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
               (setq am1 (polar am ang s1))
               (setq an1 (polar am1 (+ ang 1.570796) s2))
			(command "pline" am an "")
			(command "donut" "0" rad an1 "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
	       );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

;;;;;
(defun c:1043()       ;梯田坎1043
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8530"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.002 wwblc))
	    (setq S (* 0.001 wwblc))
         (setvar "PLINEWID" 0)
         (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
	      );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
      );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

(defun c:1035()       ;冲沟1035
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8450"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.002 wwblc))
	    (setq S (* 0.001 wwblc))
         (setvar "PLINEWID" 0)
         (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
	      );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
      );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction
;;;;;
(defun c:912a()       ;省，自治区，直辖市已定界912a

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "7130"))))
  (setq len (sslength ss))
  (setq tn 0)
  (setq en (ssname ss tn))

   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
  
    (command "layer" "m" lla "c" "4" "" "")

  (while (< tn len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
        (setq width (* 0.0006 wwblc))       ;;;注意线宽
        (setvar "PLINEWID" width);;;
          ;(setq d d1)
	  (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
(setq d1 (* 0.006 wwblc))
(setq d2 (* 0.004 wwblc))
(setq d d1)
(setq kk 1)
(setq t2 (* 0.01 wwblc))
(setq t1 (* 0.000 wwblc))
(setq t (* 0.0073 wwblc))
(setq yy 0)
(setq g1 t1)
(setq g2 t2)
(setq g (* 0.0087 wwblc))
(setq vv 0)
(setq SP (nth i lt))
(setq i (+ 1 I))
(setq EP (nth i lt))

(WHILE (/= EP nil)
  (setq ll (distance sp ep))
  (setq aa (angle sp ep))
  (setq pcy sp)
  (while (>= ll d)
	 (setq pm (polar pcy aa d))
	 (if (= kk 1) (progn (command "pline" pcy pm "")))
	 (setq ll (- ll d))
	 (if (= kk 1) (progn (setq kk 2) (setq d d2))
		      (progn (setq kk 1) (setq d d1))
	 )
	 (setq pcy pm)
   )
   (if (= kk 1) (progn (command "pline" pcy ep "")))
   (setq d (- d ll))

   (setq ll (distance sp ep))
   (setq pcz sp)
   (while (>= ll t)
	  (setq bm (polar pcz aa t))
	  (if (= yy 1) (command "DONUT" "0" width bm ""))
	  (setq ll (- ll t))
	  (if (= yy 1) (progn (setq yy 0) (setq t t2))
		       (progn (setq yy 1) (setq t t1))
	  )
	  (setq pcz bm)
   )
   (if (= yy 1) (progn (command "DONUT" "0" width pcz "")))
   (setq t (- t ll))
   (setq pcx sp)
   (setq ll (distance sp ep))
   (while (>= ll g)
	  (setq cm (polar pcx aa g))
	  (if (= vv 1) (command "DONUT" "0" width cm ""))
	  (setq ll (- ll g))
	  (if (= vv 1) (progn (setq vv 0) (setq g g2))
		       (progn (setq vv 1) (setq g g1))
	  )
	  (setq pcx cm)
   )
   (if (= vv 1) (progn (command "DONUT" "0" width pcx "")))
   (setq g (- g ll))
   (setq sp ep)
	
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
        (setq i (+ 1 i))  
		(setq EP (nth i lt))
	)
	
	));IF LT IS NULL BLOCK
  (setq tn (+ 1 tn))
  (setq en (ssname ss tn))
  )

(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
)


;;;;;
(defun c:913a()       ;自治州、地区、盟、地级市已定界913a

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "7140"))))
  (setq len (sslength ss))
  (setq tn 0)
  (setq en (ssname ss tn))

   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
  
    (command "layer" "m" lla "c" "4" "" "")

  (while (< tn len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
        (setq width (* 0.0004 wwblc))       ;;;注意线宽
        (setvar "PLINEWID" width);;;
          ;(setq d d1)
	  (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
(setq d1 (* 0.006 wwblc))
(setq d2 (* 0.012 wwblc))
(setq d d1)
(setq kk 1)
(setq t2 (* 0.012 wwblc))
(setq t1 (* 0.006 wwblc))
(setq t (* 0.008 wwblc))
(setq yy 0)
(setq g1 0.0)
(setq g2 (* 0.018 wwblc))
(setq g (* 0.016 wwblc))
(setq ww (* 0.0004 wwblc))
(setq vv 0)
(setq SP (nth i lt))
(setq i (+ 1 I))
(setq EP (nth i lt))

(WHILE (/= EP nil)
  (SETQ ll (distance sp ep))
  (setq aa (angle sp ep))
  (setq pcy sp)
  (while (>= ll d)
	 (setq pm (polar pcy aa d))
	 (if (= kk 1) (progn (command "pline" pcy "w" ww ww pm "w" 0 0 "")))
	 (setq ll (- ll d))
	 (if (= kk 1) (progn (setq kk 2) (setq d d2))
		      (progn (setq kk 1) (setq d d1))
	 )
	 (setq pcy pm)
   )
   (if (= kk 1) (progn (command "pline" pcy "w" ww ww ep "w" 0 0 "")))
   (setq d (- d ll))

   (setq ll (distance sp ep))
   (setq pcz sp)
   (while (>= ll t)
	  (setq bm (polar pcz aa t))
	  (if (= yy 1) (command "pline" pcz "w" ww ww bm "w" 0 0 ""))
	  (setq ll (- ll t))
	  (if (= yy 1) (progn (setq yy 0) (setq t t2))
		       (progn (setq yy 1) (setq t t1))
	  )
	  (setq pcz bm)
   )
   (if (= yy 1) (progn (command "pline" pcz "w" ww ww ep "w" 0 0 "")))
   (setq t (- t ll))
   (setq pcx sp)
   (setq ll (distance sp ep))
   (while (>= ll g)
	  (setq cm (polar pcx aa g))
	  (if (= vv 1) (command "donut" 0 width cm ""))
	  (setq ll (- ll g))
	  (if (= vv 1) (progn (setq vv 0) (setq g g2))
		       (progn (setq vv 1) (setq g g1))
	  )
	  (setq pcx cm)
   )
   (if (= vv 1) (progn (command "donut" 0 width pcx "")))
   (setq g (- g ll))
   (setq sp ep)

;;;;;;;;;;;;;;;;;;;;;以上为替换部分
        (setq i (+ 1 i))  
		(setq EP (nth i lt))
	)
	
	));IF LT IS NULL BLOCK
  (setq tn (+ 1 tn))
  (setq en (ssname ss tn))
  )

(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
)



;;;;;
(defun c:914a()       ;县、自治县、旗、县级市已定界914a

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "7150"))))
  (setq len (sslength ss))
  (setq tn 0)
  (setq en (ssname ss tn))

   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
  
    (command "layer" "m" lla "c" "4" "" "")

  (while (< tn len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
        (setq width (* 0.0003 wwblc))       ;;;注意线宽
        (setvar "PLINEWID" width);;;
          ;(setq d d1)
	  (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
(setq d1 (* 0.006 wwblc))
(setq d2 (* 0.004 wwblc))
(setq d d1)
(setq kk 1)
(setq t1 (* 0.01 wwblc))
(setq t2 0.0)
(setq t (* 0.008 wwblc))
(setq yy 0)
(setq SP (nth i lt))
(setq i (+ 1 I))
(setq EP (nth i lt))
(WHILE (/= EP nil)
  (SETQ ll (distance sp ep))
  (setq aa (angle sp ep))
  (setq pcy sp)
  (while (>= ll d)
	 (setq am (polar pcy aa d))
	 (if (= kk 1) (progn (command "pline" pcy am "")))
	 (setq ll (- ll d))
	 (if (= kk 1) (progn (setq kk 2) (setq d d2))
		      (progn (setq kk 1) (setq d d1))
	 )
	 (setq pcy am)
   )
   (if (= kk 1) (progn (command "pline" pcy ep "")))
   (setq d (- d ll))

   (setq ll (distance sp ep))
   (while (>= ll t)
	  (setq am (polar sp aa t))
	  (if (= yy 1) (command "DONUT" "0" WIdth am ""))
	  (setq ll (- ll t))
	  (if (= yy 1) (progn (setq yy 0) (setq t t1))
		       (progn (setq yy 1) (setq t t2))
	  )
	  (setq sp am)
   )
   (if (= yy 1) (progn (command "DONUT" "0" WIDth sp "")))
   (setq t (- t ll))
   (setq sp ep)

;;;;;;;;;;;;;;;;;;;;;以上为替换部分
        (setq i (+ 1 i))  
		(setq EP (nth i lt))
	)
	
	));IF LT IS NULL BLOCK
  (setq tn (+ 1 tn))
  (setq en (ssname ss tn))
  )

(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
)

;;;;;
(defun c:915a()       ;乡、镇已定界915a

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "7160"))))
  (setq len (sslength ss))
  (setq tn 0)
  (setq en (ssname ss tn))

   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")

  (while (< tn len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
        (setq width (* 0.0002 wwblc))       ;;;注意线宽
        (setvar "PLINEWID" width);;;
	
(setq dd 1)
(setq d (* wwblc 0.006))
(setq d1 (* wwblc 0.006))
(setq d2 (* wwblc 0.012))
(setq tt 0)
(setq t (* wwblc 0.008))
(setq t1 (* wwblc 0.006))
(setq t2 (* wwblc 0.012))
(setq gg 0)
(setq g (* wwblc 0.015333))
(setq g1 0.0)
(setq g2 (* wwblc 0.018))
(setq xx 0)
(setq x (* wwblc 0.016666))
(setq x1 0.0)
(setq x2 (* wwblc 0.018))
(setq sp(nth i lt))
(setq i (+ 1 I))
(setq ep (nth i lt))

(WHILE (/= EP nil)
  (setq ll (distance sp ep))
  (setq aa (angle sp ep))
  (setq pcy sp)
  (while (>= ll d)
	 (setq pm (polar pcy aa d))
	 (if (= dd 1) (progn (command "pline" pcy pm "")))
	 (setq ll (- ll d))
	 (if (= dd 1) (progn (setq dd 0) (setq d d2))
	              (progn (setq dd 1) (setq d d1))
	  );endif
	 (setq pcy pm)
   );endwhile
   (if (= dd 1) (progn (command "pline" pcy ep "")))
   (setq d (- d ll))

   (setq ll (distance sp ep))
   (setq pcz sp)
   (while (>= ll t)
	  (setq bm (polar pcz aa t))
	  (if (= tt 1) (command "pline" pcz bm ""))
	  (setq ll (- ll t))
	  (if (= tt 1) (progn (setq tt 0) (setq t t2))
		       (progn (setq tt 1) (setq t t1))
    );endwhile
    (setq pcz bm)
   )
   (if (= tt 1) (progn (command "pline" pcz ep "")))
   (setq t (- t ll))
   (setq pcx sp)
   (setq ll (distance sp ep))
   (while (>= ll g)
	  (setq cm (polar pcx aa g))
	  (if (= gg 1) (command "DONUT" "0" WIDth cm ""))
	  (setq ll (- ll g))
	  (if (= gg 1) (progn (setq gg 0) (setq g g2))
		       (progn (setq gg 1) (setq g g1))
	  )
	  (setq pcx cm)
   )
   (if (= gg 1) (progn (command "DONUT" "0" width pcx "")))
   (setq g (- g ll))
   (setq pcn sp)
   (setq ll (distance sp ep))
   (while (>= ll x)
	  (setq dm (polar pcn aa x))
	  (if (= xx 1) (command "DONUT" "0" width dm ""))
	  (setq ll (- ll x))
	  (if (= xx 1) (progn (setq xx 0) (setq x x2))
		          (progn (setq xx 1) (setq x x1))
	  );endif
	  (setq pcn dm)
   );endwhile
   (if (= xx 1) (progn (command "DONUT" "0" width pcn "")))
   (setq x (- x ll))
   (setq sp ep)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
   (setq i (+ 1 i))  
   (setq EP (nth i lt))
  )
  ));IF LT IS NULL BLOCK
  (setq tn (+ 1 tn))
  (setq en (ssname ss tn))
  )

(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction

;;;;;;;
(defun c:846a()       ;土堤846a
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6460"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.002 2000))
	    (setq S (* 0.001 2000))
         ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
         ;(setvar "PLINEWID" width);;;
         (setvar "PLINEWID" 0)
         (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
               (setq pc am)
	      );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
	
   ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "aunits" 0)
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;
(defun c:846b()      ;;垅846b
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6461"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
    (setq lt (get-line-list en))
    (IF (/= LT NIL)
      (PROGN
	  (setq i 0)
       (setq d1 (* 0.002 2000));;注意这两行
	  (setq d2 (* 0.0006 2000));;
       (setq width (* 0.0002 wwblc))       ;;;注意线宽
       (setvar "PLINEWID" width) ;;;
       (setq D D1)
	  (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) d2))
               (setq al (polar am (- ang 1.570796) d2))
			(command "pline" an al "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
		  );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
           (setq i (+ 1 i))  
           (setq DC (nth i lt))
       );endwhile
   ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");;根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

;;;;;;
(defun c:733()         ;地下管道733：虚线--实线4，空格1，线宽0.15
(undo_begin)
  (setvar "cmdecho" 0)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "5312"))))
 )) 
(if (/= SsSel nil)(a733_a sssel))
 (undo_end)
)  
(defun a733_a(SsSel)  
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
 (while (< t len)
   (setq lt (get-line-list en))
   (IF (/= LT NIL)
     (PROGN
	  (setq i 0)
       (setq d1 (* 0.004 wwblc))
	  (setq d2 (* 0.001 wwblc))
       (setvar "PLINEWID" 0)
       (setq D D1)
	  (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (setq kk 1)
	  (WHILE (/= dc nil)

		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
                );endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1))
			 );endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		 );endif

		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction

;;;;;;;;;;
(defun c:444()       ;栅栏、栏杆444  
(undo_begin)
(if (= jieshi "1")
 (PROGN
  (setq ss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2450"))))
  (if (= ss nil)(PROGN(print "找不到 2450 ！")(exit)))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))
 )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
  (setq len 1)
  (setq t 0)
  ));endif 
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
  (setq lt (get-line-list en))
  (setq flag nil)
    (IF (/= LT NIL)
      (PROGN
         (setq i 0)
         (setq d1 (* 0.009 2000));;注意这两行
	     (setq d2 (* 0.001 2000));;
         (setvar "PLINEWID" 0)
         (setq D D1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	    (setq kk 1)
	    (WHILE (/= dc nil)
		  (setq km (distance pc dc))
		  (setq ang (angle pc dc))
		  (while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		);endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
	     (setq DC (nth i lt))
	);endwhile
	    (setq i 0)
        (setq d1 (* 0.005 wwblc))
	    (setq S (* 0.001 wwblc))
         (setq rad (* 0.0005 wwblc))
        ( setvar "PLINEWID" 0)
        (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
                     (setq am (polar pc ang (- d (/ d2 2))))
                     (setq an (polar am (+ ang 1.570796) s))
                  (cond
                    ((= flag nil)	(progn (command "pline" am an "") (setq flag 1)))
                    ((= flag 1)   (progn (command "circle" am rad) (setq flag nil)))
                   )
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
             );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
   )
);IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (if (= jieshi "1")(setq en (ssname ss t)))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;地面上的输电线
(defun c:711a()
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线�?  ")
   (setq sssel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>") (8 .  "5111"))))
 ) 
) 
(if (/= SsSel nil)
(progn
 (setq SsLen (sslength SsSel))
 (setq T 0)
 (setq EnName (ssname SsSel T))
 (setq EnList (entget EnName))
 (setq EnLa (cdr (assoc 8 EnList)))
 (setq EnNewLa (strcat EnLa "_sym"))
 (command "layer" "m" EnNewLa "c" "4" "" "")
 (while (< T SsLen)
   (setq EnList (get-line-list EnName))
   (setq Rad (* 0.0005 wwblc))
   (setvar "plinewid" 0)
   (if (/= EnList nil)
     (progn
        (setq I 0)
        (setq FirPoint (nth I EnList))
        (setq I (+ I 1))
        (setq SecPoint (nth I EnList))
        (while (/= SecPoint nil)
           (setq Dist (distance FirPoint  SecPoint))
           (setq Ang (angle FirPoint SecPoint))
           (setq AidFisP (polar FirPoint Ang  Rad))
           (setq AidSecP (polar SecPoint (+ Ang  PI) Rad))
           (command "pline" AidFisP AidSecP "")
           (command "insert" "711a" FirPoint (/ wwblc 1000) "" (- Ang (/ PI 2.0)))
           (command "insert" "711a" SecPoint (/ wwblc 1000) "" (- (+ Ang PI) (/ PI 2.0)))
           (setq I (+ I 1))
           (setq FirPoint SecPoint)
           (setq SecPoint (nth I Enlist))
         );end while SecPoint
      );end progn
    );end if
    (setq T (+ T 1))
    (setq EnName (ssname SsSel T))
  );end while T
  (setvar "plinewid" 0)
  (setvar "aunits" 0)
  (setvar "clayer" "0")
  (command "layer" "f" Enla "")
)
(prompt "\n未找到曲线!请检查层以及是否为三维线!")
);end if SsSel
(undo_end)
);end 711a
;;;;地面上的配电线

(defun c:712a()
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq sssel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>") (8 .  "5121"))))
 ) 
) 
(if (/= SsSel nil)
(progn
 (setq SsLen (sslength SsSel))
 (setq T 0)
 (setq EnName (ssname SsSel T))
 (setq EnList (entget EnName))
 (setq EnLa (cdr (assoc 8 EnList)))
 (setq EnNewLa (strcat EnLa "_sym"))
 (command "layer" "m" EnNewLa "c" "4" "" "")
 (while (< T SsLen)
   (setq EnList (get-line-list EnName))
   (setq Rad (* 0.0005 wwblc))
   (setvar "plinewid" 0)
   (if (/= EnList nil)
     (progn
        (setq I 0)
        (setq FirPoint (nth I EnList))
        (setq I (+ I 1))
        (setq SecPoint (nth I EnList))
        (while (/= SecPoint nil)
           (setq Dist (distance FirPoint  SecPoint))
           (setq Ang (angle FirPoint SecPoint))
           (setq AidFisP (polar FirPoint Ang  Rad))
           (setq AidSecP (polar SecPoint (+ Ang  PI) Rad))
           (command "pline" AidFisP AidSecP "")
           (command "insert" "712a" FirPoint (/ wwblc 1000) "" (- Ang (/ PI 2.0)))
           (command "insert" "712a" SecPoint (/ wwblc 1000) "" (- (+ Ang PI) (/ PI 2.0)))
           (setq I (+ I 1))
           (setq FirPoint SecPoint)
           (setq SecPoint (nth I Enlist))
         );end while SecPoint
      );end progn
    );end if
    (setq T (+ T 1))
    (setq EnName (ssname SsSel T))
  );end while T
  (setvar "plinewid" 0)
  (setvar "aunits" 0)
  (setvar "clayer" "0")
  (command "layer" "f" Enla "")
)
(prompt "\n未找到曲线!请检查层以及是否为三维线!")
);end if SsSel
(undo_end)
);end 712a

;;;;地面上的通讯线

(defun c:72a()
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq sssel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>") (8 .  "5210"))))
 ) 
) 
(if (/= SsSel nil)
(progn
 (setq SsLen (sslength SsSel))
 (setq T 0)
 (setq EnName (ssname SsSel T))

 (setq EnList (entget EnName))
 (setq EnLa (cdr (assoc 8 EnList)))
 (setq EnNewLa (strcat EnLa "_sym"))
 (command "layer" "m" EnNewLa "c" "4" "" "")

 (while (< T SsLen)
   
   (setq EnList (get-line-list EnName))
   (setq Rad (* 0.0005 wwblc))
   (setvar "plinewid" 0)
   (if (/= EnList nil)
     (progn
        (setq I 0)
        (setq FirPoint (nth I EnList))
        (setq I (+ I 1))
        (setq SecPoint (nth I EnList))
        (while (/= SecPoint nil)
           (setq Dist (distance FirPoint  SecPoint))
           (setq Ang (angle FirPoint SecPoint))
           (setq AidFisP (polar FirPoint Ang  Rad))
           (setq AidSecP (polar SecPoint (+ Ang  PI) Rad))
           (command "pline" AidFisP AidSecP "")
           (command "insert" "72a" FirPoint (/ wwblc 1000) "" (- Ang (/ PI 2.0)))
           (command "insert" "72a" SecPoint (/ wwblc 1000) "" (- (+ Ang PI) (/ PI 2.0)))
           (setq I (+ I 1))
           (setq FirPoint SecPoint)
           (setq SecPoint (nth I Enlist))
         );end while SecPoint
      );end progn
    );end if
    (setq T (+ T 1))
    (setq EnName (ssname SsSel T))
  );end while T

  (setvar "plinewid" 0)
  (setvar "aunits" 0)
  (setvar "clayer" "0")
  (command "layer" "f" Enla "")
)
(prompt "\n未找到曲线!请检查层以及是否为三维线!")
);end if SsSel
(undo_end)
);end 72a

;;;;;;
(defun c:Xx()         ;按给定的参数绘虚线Xx
	
  (setq en (car(entsel "\n请选择虚线:")));绘虚线边
  (setq d1 (getdist "\n实线长:"))
   (setq d2 (getdist "\n空格长:"))
    (setq width (getdist "\n线宽:"))
	
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (setq lt (get-line-list en))
  (IF (/= LT NIL)
     (PROGN
       (setq i 0)
       (setq d1 (* d1 2.0))
       (setq d2 (* d2 2.0))
       (setq width (* width 2.0))      ;;;注意线宽 
       (setvar "PLINEWID" width);;;
       (setq D D1)
	   (setq PC (nth i lt))
	  (setq i (+ 1 I))
	  (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	(setq kk 1)
	(WHILE (/= dc nil)

		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))

			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			 );endif
			(setq pc am)
		);endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif

		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	);endwhile
  ));IF LT IS NULL BLOCK
  (setvar "plinewid" 0)
);end xx

(defun c:kan ()       ;将选定的曲线解释成坎状符号kan
(undo_begin)
  (setvar "cmdecho" 0)
  (prompt "\n注意!!坎加在画线起点的左边!!")

  (setq en (car (entsel "\n选择曲线:")))

   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
        (setq d1 (* 0.002 wwblc))
	    (setq S (* 0.001 wwblc))
        ;(setq width (* 0.00015 wwblc))       ;;;注意线宽
        ;(setvar "PLINEWID" width);;;
        ( setvar "PLINEWID" 0)
        (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(setq an (polar am (+ ang 1.570796) s))
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
           );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
	
   ));IF LT IS NULL BLOCK
 
(setvar "PLINEWID" 0)
;(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;;;;;;;
(defun c:835a ()       ;单线干沟835a
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "6341"))))
 )) 
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
  (setq lt (get-line-list en))
  (IF (/= LT NIL)
      (PROGN
         (setq i 0)
         (setq PC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	(SETQ WID (* 0.0003 wwblc))
	(SETVAR "PLINEWID" WID)
	(SETQ D1 (* 0.003 wwblc))
	(SETQ D2 (* 0.001 wwblc))
	(SETQ S1 (* 0.001 wwblc))
	(SETQ D (/ D1 2))
	(SETQ S S1)
	(SETQ X0 (CAR PC))
	(SETQ Y0 (CADR PC))
	(SETQ KP 1)
	(SETQ KK 0)
	(SETQ KW 1)
	(SETQ KT 1)
	(WHILE (/= KK 1)
		(IF (= KP 1)
			(PROGN (setq i (+ 1 I))(setq DC (nth i lt))
			(IF (= DC NIL)
				(PROGN(SETQ KK 1))
				(PROGN(SETQ X1 (CAR DC))
				(SETQ Y1 (CADR DC))
				))
			))
		(SETQ KM (DISTANCE (LIST X0 Y0) (LIST X1 Y1)))
		(IF (< KM D)
			(PROGN(SETQ D (- D KM))
			(SETQ KP 1)

			(IF (/= KW 3)
				(PROGN(COMMAND "PLINE" (LIST X0 Y0) (LIST X1 Y1) "")
				))
			(SETQ X0 X1)
			(SETQ Y0 Y1)
			)
			(PROGN(SETQ HS D)
			(SETQ X (+ X0 (* HS (/ (- X1 X0) KM))))
			(SETQ Y (+ Y0 (* HS (/ (- Y1 Y0) KM))))
			(IF (/= KW 3)
				(PROGN(COMMAND "PLINE" (LIST X0 Y0) (LIST X Y) "")
				))
			(IF (= KW 1)
				(PROGN(IF (= KT 1)
					(PROGN(SETQ XD (- X (* S (/ (- Y1 Y0) KM))))
					(SETQ YD (+ Y (* S (/ (- X1 X0) KM))))
					)
					(PROGN(SETQ XD (+ X (* S (/ (- Y1 Y0) KM))))
					(SETQ YD (- Y (* S (/ (- X1 X0) KM))))
					))
                           (setvar "plinewid" 0)
				(COMMAND "PLINE" (LIST XD YD) (LIST X Y) "")
                           (setvar "plinewid" wid)
				))
			(SETQ KW (+ KW 1))
			(IF (> KW 3)
				(PROGN(SETQ KW 1)
				(SETQ D (/ D1 2))
				(SETQ KT (+ KT 1))
				(IF (> KT 2)
					(PROGN(SETQ KT 1)
					))
				))
			(IF (= KW 2)
				(PROGN(SETQ D (/ D1 2))
				))
			(IF (= KW 3)
				(PROGN(SETQ D D2)
				))
			(SETQ X0 X)
			(SETQ Y0 Y)
			(SETQ KP 0)
			)
		)
)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
   );end progn  
);IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(setvar "aunits" 0)
(command "layer" "f" la "");根据需要选择此行
(undo_end)
);endfunction

;;;;改变给定层中注记和块的方向Gjd

(defun c:Gjd ()

  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
  
  ;(setq SsLay (getstring "\n输入层名:"))
  (setq NewAng (getangle "\n输入新角度:"))

;;;;;TEXT
  ;(setq SsSel (cons 8 SsLay))
  ;(setq SsSel (list '(0 . "TEXT") SsSel))
  ;(setq SsText (ssget "x" SsSel))
  (setq SsText (ssget "x" '((0 . "TEXT"))))
  (setq SsLen (sslength SsText))
  (setq I 0)
  (while (< I SsLen)
  (setq EnName (ssname SsText I))
  (setq EnList (entget EnName))
  (setq EnList (subst (cons 50 (- NewAng (/ PI 2.0))) (assoc 50 EnList) EnList))
  (entmod EnList)
  (setq I (+ I 1))
  )
;;;;;BLOCK
  ;(setq SsSel (cons 8 SsLay))
  ;(setq SsSel (list '(0 . "INSERT") SsSel))
  ;(setq SsBlock (ssget "x" SsSel))
  (setq SsBlock (ssget "x" '((0 . "INSERT"))))
  (setq SsLen (sslength SsBlock))
  (setq I 0)
  (while (< I SsLen)
  (setq EnName (ssname SsBlock I))
  (setq EnList (entget EnName))
  (setq EnList (subst (cons 50 (- NewAng (/ PI 2.0))) (assoc 50 EnList) EnList))
  (entmod EnList)
  (setq I (+ I 1))
  )
;;;;;
  (setvar "aunits" 0)
)

;;;;地面上的管道732

(defun c:732 ()
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "5311"))))
 )) 
(if (/= SsSel nil)
(progn
 (setq SsLen (sslength SsSel))
 (setq T 0)
 (setq EnName (ssname SsSel T))
 (setq EnList (entget EnName))
 (setq EnLa (cdr (assoc 8 EnList)))
 (setq EnNewLa (strcat EnLa "_sym"))
 (command "layer" "m" EnNewLa "c" "4" "" "")
 (while (< T SsLen)
   (setq EnList (get-line-list EnName))
   (setq LenList (length EnList))
   (setq Rad (* 0.0005 wwblc))
   (setvar "plinewid" 0)
   (if (/= EnList nil)
     (progn
        (setq I 0)
        (setq FirPoint (nth I EnList))
        (setq I (+ I 1))
        (setq SecPoint (nth I EnList))
        (while (/= SecPoint nil)
           (setq Dist (distance FirPoint  SecPoint))
           (setq Ang (angle FirPoint SecPoint))
           (setq AidFisP (polar FirPoint Ang  Rad))
           (setq AidSecP (polar SecPoint (+ Ang  PI) Rad))
           (if (= I 1) (setq AidFisP FirPoint)
                       (command "circle" FirPoint Rad)
           )
           (if (= I (- LenList 1)) (setq AidSecP SecPoint))
           (command "pline" AidFisP AidSecP "")
           (setq I (+ I 1))
           (setq FirPoint SecPoint)
           (setq SecPoint (nth I Enlist))
         );end while SecPoint
         ;(command "circle" FirPoint Rad)
      );end progn
    );end if
    (setq T (+ T 1))
    (setq EnName (ssname SsSel T))
  );end while T
  (setvar "plinewid" 0)
  (setvar "aunits" 0)
  (setvar "clayer" "0")
  (command "layer" "f" Enla "")
)
(prompt "\n未找到曲线!请检查层以及是否为三维线!")
);end if SsSel
(undo_end)
);end 732
;;;房屋晕线填充
(defun c:Tc ()

  (setvar "cmdecho" 0)
  (setvar "aunits" 0)
  (setvar "measurement" 1)
  (setq Ang (getangle "\n测量角度:"))
  (prompt "\n选择房屋边线:")
  (setq TcScl 1)
  (setq Ang (- Ang (/ PI 4.0)))
  (command "hatch" "ansi31" TcScl Ang pause)
  (setvar "aunits" 0)
)

;;;;;
(defun c:1041a ()       ;未加固斜坡1041a
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8511"))))
 ))
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.002 wwblc))
	    (setq S1 (* 0.001 wwblc))
           (setq S2 (* 0.003 wwblc))
         (setvar "PLINEWID" 0)
         (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))
	    (setq DC (nth i lt))
          (setq Flag 0)
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= Flag 0) 
                        (progn (setq an (polar am (+ ang 1.570796) s1))
                               (setq Flag 1)
                         )
                        (progn (setq an (polar am (+ ang 1.570796) s2))
                               (setq Flag 0)
                        )
                     )
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
	      );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
      );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction
(defun c:1041b ()       ;已加固斜坡1041b
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "8512"))))
 ))
  (setq len (sslength SsSel))
  (setq t 0)
  (setq en (ssname SsSel t))
   (setq ed (entget en))
   (setq la (cdr (assoc 8 ed)))
   (setq lla (strcat la "_sym"))
   (command "layer" "m" lla "c" "4" "" "")
  (while (< t len)
     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (PROGN
	    (setq i 0)
         (setq d1 (* 0.002 wwblc))
	    (setq S1 (* 0.001 wwblc))
           (setq S2 (* 0.003 wwblc))         
           (setq S3 (* 0.002 wwblc))
           (setq rad (* 0.0003 wwblc))
         (setvar "PLINEWID" 0)
         (setq d d1)
	    (setq PC (nth i lt))
	    (setq i (+ 1 I))  
	    (setq DC (nth i lt))
          (setq Flag 0)
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	  (WHILE (/= dc nil)
		(command "pline" pc dc "")
		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= Flag 0) 
                        (progn (setq an (polar am (+ ang 1.570796) s1))
                               (setq Flag 1)
                               (setq an1 (polar am (+ ang 1.570796) s3))
                               (command "donut" "0" rad an1 "")
                         )
                        (progn (setq an (polar am (+ ang 1.570796) s2))
                               (setq Flag 0)
                        )
                     )
			(command "pline" am an "")
			(setq km (- km d))
			(setq d d1)
			(setq pc am)
	      );endwhile
		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
      );endwhile
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname SsSel t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
(setvar "aunits" 0)
(undo_end)
);endfunction

;;;;架空的管道731b(不依比例尺的墩架)

(defun c:731b ()
(undo_begin)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq SsSel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "5313"))))
 )) 
(if (/= SsSel nil)
(progn
 (setq SsLen (sslength SsSel))
 (setq T 0)
 (setq EnName (ssname SsSel T))

 (setq EnList (entget EnName))
 (setq EnLa (cdr (assoc 8 EnList)))
 (setq EnNewLa (strcat EnLa "_sym"))
 (command "layer" "m" EnNewLa "c" "4" "" "")

 (while (< T SsLen)
   
   (setq EnList (get-line-list EnName))
   (setq LenList (length EnList))
   (setvar "plinewid" 0)
   (if (/= EnList nil)
     (progn
        (setq I 0)
        (setq FirPoint (nth I EnList))
        (setq I (+ I 1))
        (setq SecPoint (nth I EnList))
        (while (/= SecPoint nil)
           (setq Dist (distance FirPoint  SecPoint))
           (setq Ang (angle FirPoint SecPoint))
           (setq AidFisP (polar FirPoint Ang  0))
           (setq AidSecP (polar SecPoint (+ Ang  PI) 0))
           (if (= I 1) (setq AidFisP FirPoint)
                       (command "insert" "731b" FirPoint (/ wwblc 1000) "" Ang)
           )
           (if (= I (- LenList 1)) (setq AidSecP SecPoint))
           (command "pline" AidFisP AidSecP "")
           (setq I (+ I 1))
           (setq FirPoint SecPoint)
           (setq SecPoint (nth I Enlist))
         );end while SecPoint
         ;(command "circle" FirPoint Rad)
      );end progn
    );end if
    (setq T (+ T 1))
    (setq EnName (ssname SsSel T))
  );end while T

  (setvar "plinewid" 0)
  (setvar "aunits" 0)
  (setvar "clayer" "0")
  (command "layer" "f" Enla "")
)
(prompt "\n未找到曲线!请检查层以及是否为三维线!")
);end if SsSel
 (undo_end)
);end 731b

;;;;;;;;;;
(defun c:835b ()       ;单线干沟835b

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "6342"))))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")

  (while (< t len)
  (setq lt (get-line-list en))
  (IF (/= LT NIL)
      (PROGN
         (setq i 0)
         (setq PC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
	(SETQ WID (* 0.0 wwblc))
	(SETVAR "PLINEWID" WID)
	(SETQ D1 (* 0.003 wwblc))
	(SETQ D2 (* 0.001 wwblc))
	(SETQ S1 (* 0.001 wwblc))
	(SETQ D (/ D1 2))
	(SETQ S S1)
	(SETQ X0 (CAR PC))
	(SETQ Y0 (CADR PC))
	(SETQ KP 1)
	(SETQ KK 0)
	(SETQ KW 1)
	(SETQ KT 1)
	(WHILE (/= KK 1)
		(IF (= KP 1)
			(PROGN (setq i (+ 1 I))(setq DC (nth i lt))
			(IF (= DC NIL)
				(PROGN(SETQ KK 1))
				(PROGN(SETQ X1 (CAR DC))
				(SETQ Y1 (CADR DC))
				))
			))

		(SETQ KM (DISTANCE (LIST X0 Y0) (LIST X1 Y1)))
		(IF (< KM D)
			(PROGN(SETQ D (- D KM))
			(SETQ KP 1)

			(IF (/= KW 3)
				(PROGN(COMMAND "PLINE" (LIST X0 Y0) (LIST X1 Y1) "")
				))

			(SETQ X0 X1)
			(SETQ Y0 Y1)
			)


			(PROGN(SETQ HS D)
			(SETQ X (+ X0 (* HS (/ (- X1 X0) KM))))
			(SETQ Y (+ Y0 (* HS (/ (- Y1 Y0) KM))))

			(IF (/= KW 3)
				(PROGN(COMMAND "PLINE" (LIST X0 Y0) (LIST X Y) "")
				))
	       	(IF (= KW 1)
				(PROGN(IF (= KT 2)
					(PROGN(SETQ XD (+ X (* S (/ (- Y1 Y0) KM))))
					(SETQ YD (- Y (* S (/ (- X1 X0) KM))))
					(COMMAND "LINE" (LIST XD YD) (LIST X Y) "")
					))
				))


			(SETQ KW (+ KW 1))
			(IF (> KW 3)
				(PROGN(SETQ KW 1)
				(SETQ D (/ D1 2))
				(SETQ KT (+ KT 1))
				(IF (> KT 2)
					(PROGN(SETQ KT 1)
					))
				))
			(IF (= KW 2)
				(PROGN(SETQ D (/ D1 2))
				))
			(IF (= KW 3)
				(PROGN(SETQ D D2)
				))

			(SETQ X0 X)
			(SETQ Y0 Y)

			(SETQ KP 0)
			)
		)
)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分

   );end progn  
);IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname ss t))
 );endwhile
(setvar "PLINEWID" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction

;;;;;格网坐标;;;;;;;;;;;;;;;
(defun c:zjxy()
   (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
   (command "layer" "s" "9800" "" "")
   (setq au (getvar "aunits"))
   (setvar "aunits" 1)
   (setq e (entsel "SELCET GRID OBJECT:"))
   (setq en (car e))
   (setq ed (entget en))
   (setq pt (cdr (assoc 10 ed)))
   (setq ptx (car pt))
   (setq pty (cadr pt))
   (setq px (itoa (fix ptx)))
   (setq py (itoa (fix pty)))
   (setq x "X")
   (setq y "Y")
   (setq zx (strcat y px))
   (setq zy (strcat x py))
   (setq pd (getpoint pt "请指定方向:"))
   (setq pdx (car pd))
   (setq pdy (cadr pd))
   (cond
      ((< pdx ptx) (setq pzx (list (- ptx 30) (+ pty 0.4) 0)))
      ((> pdx ptx) (setq pzx (list (+ ptx 0.5) (+ pty 0.4) 0)))
   )
   (cond
      ((> pdy pty) (setq pzy (list (+ ptx 0.4) (+ pty 38) 0)))
      ((< pdy pty) (setq pzy (list (- ptx 0.4) (+ pty 6) 0)))
  )
  (command "text" pzx 5 0 zy) 
  (cond 
        ((> pdy pty) (command "text" pzy 5 270 zx))
        ((< pdy pty) (command "text" pzy 5 90 zx))
  )
 (setvar "aunits" 0)
)

;;;;一般铁路611
(defun c:611()

    (setvar "cmdecho" 0)
    (setvar "aunits" 3)
    (setvar "auprec" 4)

  (setq ss (ssget "x" '((0 . "POLYLINE") (8 . "4110"))))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")

  (while (< t len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (progn
	 (setq i 0)
        (setq d1 (* 0.01 wwblc))
	 (setq d2 (* 0.01 wwblc))
        (setq width (* 0.0008 wwblc))      ;;;注意线宽 
        (setvar "PLINEWID" width);;;
        (setq D D1)
	 (setq PC (nth i lt))
	 (setq i (+ 1 I))
        (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (setq ang (angle pc dc))
        (command "offset" (/ width 2.0) en (polar pc (+ ang (/ pi 2.0)) d1) "")
        (command "change" "last" "" "p" "la" lla "")
        (command "offset" (/ width 2.0) en (polar pc (- ang (/ pi 2.0)) d1)"")
        (command "change" "last" "" "p" "la" lla "")
	  (setq kk 1)
	  (WHILE (/= dc nil)

		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif

		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
	
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname ss t))
 );endwhile
(setvar "PLINEWID" 0)
(setvar "aunits" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction


;;;;窄轨铁路613
(defun c:613()

    (setvar "cmdecho" 0)
    (setvar "aunits" 3)
    (setvar "auprec" 4)

  (setq ss (ssget "x" '((0 . "LWPOLYLINE") (8 . "4130"))))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")

  (while (< t len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (progn
	 (setq i 0)
        (setq d1 (* 0.006 wwblc))
	 (setq d2 (* 0.006 wwblc))
        (setq width (* 0.0006 wwblc))      ;;;注意线宽 
        (setvar "PLINEWID" width);;;
        (setq D D1)
	 (setq PC (nth i lt))
	 (setq i (+ 1 I))
        (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (setq ang (angle pc dc))
        (command "offset" (/ width 2.0) en (polar pc (+ ang (/ pi 2.0)) d1) "")
        (command "change" "last" "" "p" "la" lla "")
        (command "offset" (/ width 2.0) en (polar pc (- ang (/ pi 2.0)) d1)"")
        (command "change" "last" "" "p" "la" lla "")
	  (setq kk 1)
	  (WHILE (/= dc nil)

		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif

		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
	
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname ss t))
 );endwhile
(setvar "PLINEWID" 0)
(setvar "aunits" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction

;;;;轻便轨道615
(defun c:615()

    (setvar "cmdecho" 0)
    (setvar "aunits" 3)
    (setvar "auprec" 4)

  (setq ss (ssget "x" '((0 . "LWPOLYLINE") (8 . "4150"))))
  (setq len (sslength ss))
  (setq t 0)
  (setq en (ssname ss t))

  (setq ed (entget en))
  (setq la (cdr (assoc 8 ed)))
  (setq lla (strcat la "_sym"))
  (command "layer" "m" lla "c" "4" "" "")

  (while (< t len)

     (setq lt (get-line-list en))
     (IF (/= LT NIL)
       (progn
	 (setq i 0)
        (setq d1 (* 0.002 wwblc))
	 (setq d2 (* 0.002 wwblc))
        (setq width (* 0.0006 wwblc))      ;;;注意线宽 
        (setvar "PLINEWID" width);;;
        (setq D D1)
	 (setq PC (nth i lt))
	 (setq i (+ 1 I))
        (setq DC (nth i lt))
;;;;;;;;;;;;;;;;;;;;;以下为替换部分
        (setq ang (angle pc dc))
        (command "offset" (/ width 2.0) en (polar pc (+ ang (/ pi 2.0)) d1) "")
        (command "change" "last" "" "p" "la" lla "")
        (command "offset" (/ width 2.0) en (polar pc (- ang (/ pi 2.0)) d1)"")
        (command "change" "last" "" "p" "la" lla "")
	  (setq kk 1)
	  (WHILE (/= dc nil)

		(setq km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
			(setq am (polar pc ang d))
			(if (= kk 1)
				(progn(command "pline" pc am ""))
			);endif
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
				(setq d d2))
				(progn(setq kk 1)
				(setq d d1));endprogn
			);endif
			(setq pc am)
		 );endwhile
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
		);endif

		(setq d (- d km))
		(setq pc dc)
;;;;;;;;;;;;;;;;;;;;;以上为替换部分
          (setq i (+ 1 i))  
		(setq DC (nth i lt))
	 );endwhile
	
  ));IF LT IS NULL BLOCK
  (setq t (+ 1 t))
  (setq en (ssname ss t))
 );endwhile
(setvar "PLINEWID" 0)
(setvar "aunits" 0)
(command "layer" "f" la "");根据需要选择此行
);endfunction

(defun c:mj();;;;计算面积

  (setvar "cmdecho" 0)
  (setq EnName (car (entsel "\n选择内图廓线:")))
    (command "area" "o" EnName)
    (setq Mj (getvar "area"))
    (setq Mj (/  Mj (expt (* 0.1 wwblc) 2)))
    (prompt "\n此图面积为:")
    (print MJ)
)
     
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:tcd();;沙砾地
(setq md (getreal "\n请输入密度值;[20]")) 
(command "_hatch" "dots" md "0")
(print)
)

;;;;;;;;;;;;;;;;;;;插符号；；；；；；；；；；；；；；；
(defun chafuhao(chengma kuaimin fangxiang)
 (if (= wwblc nil) (setq xl 4.0))
 (if (= wwblc 500) (setq xl 1.0))
 (if (= wwblc 1000) (setq xl 2.0))
 (if (= wwblc 2000) (setq xl 4.0))
 (command "layer" "m" chengma "c" "7" "" "")
 (setq p1 (getpoint "\n 插入点:"))
(while (/= p1 nil)
 (if (= fangxiang 0) 
   (progn
     (setq p3 0)
   )
   (progn
     (setq p2 (getorient p1 "\n请指定方向;"))
     (setq p3(/(* p2 180) 3.1415926))
   )
 )
 (command "insert" kuaimin p1 xl xl p3)
 (setq p1 (getpoint "\n 插入点:"))
)   
 
(print)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;GB码对应名称
(defun c:GBmc()
(print)
(setq duixiang (entsel "选择一个对象:"))
(if (/= duixiang nil)
(progn          
(setq Myen (car duixiang))
(setq Med (entget myen))
(setq cenma (assoc 8 Med))
(setq cema (cdr cenma))
))              

(setq fil(findfile "gb.w"))
(setq f(open fil "r"))
 (setq txt(read-line f))
 (setq sss 0)
 (setq len (strlen cema))
(if (> len 3)
 (progn
 (while(/= txt "END")
   (setq txt1(substr txt 1 4))
   (setq cema1(substr cema 1 4))
   (if (= txt1 cema1) 
     (progn 
       (print (strcat "-------------" txt "---------------"))
       (setq txt "END")
       (setq sss 1)
     ) 
     (progn
       (setq txt(read-line f))
     )
   ) 
 )
(close f)
(if (= sss 0)(print (strcat "***********在GB库中找不到: " cema " ***********")))
)
  (progn
   (print (strcat "***********在GB库中找不到: " cema " ***********"))
  )
);endif
(print)
)
;;;;
;;;;处理文本 + ;;;
 (defun c:bg()
 (setvar "cmdecho" 0)
 ;(setq ed8 "8340")
 ;(setq ed0 "text") 
 (setq ss0 (ssget "x" (list (cons 0 "text"))))
 (if (/= ss0 nil)
   (progn
    (setq i 0) 
    (setq j 0)
    (setq sslen0 (sslength ss0))
    (while (< i sslen0)
    (setq ssen (ssname ss0 i))
    (setq ssed (entget ssen))
    (setq ss10 (cdr (assoc 10 ssed)))
    (setq sstxt1 (cdr (assoc 1 ssed)))
    (setq sstxt2 (substr sstxt1 1 1))
     (if (= sstxt2 "+")
      (progn
       (command "insert" "hp.dwg" ss10 "" "" "")
       (setq sstxt1 (substr sstxt1 2))
       (command "erase" ssen "")
       (command "text" ss10 4 0 sstxt1)
       (setq xx(+ (car ss10) 50))
       (setq yy(+ (cadr ss10) 25))
       (setq xy(list xx yy))
       (setq newtext(entlast))
       ;(command "move"  newtext  "0,0,0" xy "")
      )
     ) 
    (setq i (+ 1 i))
    )
   )
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:jb()
  (setq jbe1 (entsel "\n<靠近目标点选择,右键结束>："))
  (while (/= jbe1 nil)
  (progn
    (redraw (car jbe1) 3)
    (princ "\n选择第二条目标线,<")
    (setq jbe2 (nentsel "<靠近目标点选择,右键结束>："))
    (if (/= jbe2 nil)
    (progn  
      (setq jben1 (car jbe1))
      ;(setq jben2 (car jbe2))
      (block-enty (car jbe2))
      (setq jben2 bsenty)
      (setq jbed1 (entget jben1))
      (setq jbed2 (entget jben2))
      (setq jb0 (cdr (assoc 0 jbed1)))
      (setq jb8 (cdr (assoc 8 jbed1)))
      (setq jb18 (cdr (assoc 8 jbed2)))
      (setq jbbool 0)
      (if (not (equal jb8 jb18))
      (progn
         (print "层码不同，不能相接！！！")
	 (setq cmbol (getstring "\n是否强行接边？<Y/N>:N"))
	 (if (OR (eq cmbol "N") (eq cmbol "n") (eq cmbol ""))
	 (progn  (setq jbbool 1)
	 ))
      ))
      (if (= jbbool 0)
      (progn
      (if (OR (= jb0 "POLYLINE") (= jb0 "LWPOLYLINE"))
      (progn
      (setq jb10 (cdr (assoc 0 jbed2)))
      (if (OR (= jb10 "POLYLINE") (= jb10 "LWPOLYLINE"))
      (progn
      (setq selp1 (cadr jbe1))
      (setq selp2 (cadr jbe2))
      (setq jblist1 (get-line-list  jben1))
      (setq jblist2 (get-line-list  jben2))
      (setq p11 (car jblist1))
      (setq p12 (last jblist1))
      (setq ev11 (nth 2 p11))
      (setq ev12 (nth 2 p12))
      (setq pt11 (list (nth 0 p11) (nth 1 p11)))
      (setq pt12 (list (nth 0 p12) (nth 1 p12)))

      (setq p21 (car jblist2))
      (setq p22 (last jblist2))
      (setq ev21 (nth 2 p21))
      (setq ev22 (nth 2 p22))
      (setq pt21 (list (nth 0 p21) (nth 1 p21)))
      (setq pt22 (list (nth 0 p22) (nth 1 p22)))

      (setq spt1 (list (nth 0 selp1) (nth 1 selp1)))
      (setq spt2 (list (nth 0 selp2) (nth 1 selp2)))
      (setq jbd11 (distance spt1 pt11))
      (setq jbd12 (distance spt1 pt12))
      (setq sek 0)
      (setq selv 0)
      (if (< jbd11 jbd12)
          (progn (setq selv ev11) 
	  (setq sek 1))
	  (progn (setq selv ev12)
	  (setq sek 2))
      )
      (setq jbd21 (distance spt2 pt21))
      (setq jbd22 (distance spt2 pt22))
      (if (< jbd21 jbd22)
          (setq mpt (list (nth 0 pt21) (nth 1 pt21) selv))
	  (setq mpt (list (nth 0 pt22) (nth 1 pt22) selv))
      )
      (endpmod jben1 jb0 mpt sek)
      ))
      ))
      );;;;;;(progn (print "层码不同，不能相接！！！"))
      )
   (princ "\n选择第一条要移动的线,<")
  (setq jbe1 (entsel "<靠近目标点选择,右键结束>："))
   )(progn (setq jbe1 nil))
   )
  ))
)
;修改线实体端点坐标
(defun endpmod(sen p0 lpt se)
   (setq ed-list (entget sen))
   (if (= p0 "POLYLINE")
   (progn
      (if (= se 1)
      (progn
         (setq sen1 (entnext sen))
	 (setq sed1 (entget sen1))
	 (setq sed10 (assoc 10 sed1))
	 (setq new10 (cons 10 lpt))
	 (setq sed1 (subst new10 sed10 sed1))
	 (entmod sed1)
	 (entupd sen)
      ))
      (if (= se 2)
      (progn
         (setq sen1 (entnext sen))
	 (setq sed1 (entget sen1))
	 (setq vex (cdr (assoc 0 sed1)))
	 (while (= vex "VERTEX")
	 (progn
	    (setq lasted sed1)
	    (setq sen1 (entnext sen1))
	    (setq sed1 (entget sen1))
	    (setq vex (cdr (assoc 0 sed1)))
         ))
	 (setq sed10 (assoc 10 lasted))
	 (setq new10 (cons 10 lpt))
         (setq sed1 (subst new10 sed10 lasted))
	 (entmod sed1)
	 (entupd sen)
      ))
   ));
   (if (= p0 "LWPOLYLINE")
   (progn
      (if (= se 1)
      (progn
          (setq edlen (length ed-list))
	  (setq edi 0)
	  (while (< edi edlen)
	  (progn
	     (setq bz10 (car (nth edi ed-list)))
	     (if (= bz10 10)
	     (progn
	        (setq ed10 (nth edi ed-list))
		(setq new10 (cons 10 lpt))
		(setq ed-list (subst new10 ed10 ed-list))
		(entmod ed-list)
		(entupd sen)
		(setq edi edlen)
	     ))
	  (setq edi (+ 1 edi))
	  ))
      ));
      (if (= se 2)
      (progn
          (setq edlen (length ed-list))
	  (setq edi 0)
	  (while (< edi (- edlen 3))
	  (progn
	     (setq bz10 (car (nth edi ed-list)))
	     (if (= bz10 10)
	     (progn
		(setq edi (+ 3 edi))
	     ))
	  (setq edi (+ 1 edi))
	  ))
	  (setq ed10 (nth (- edi 4) ed-list))
	  (setq new10 (cons 10 lpt))
	  (setq ed-list (subst new10 ed10 ed-list))
	  (entmod ed-list)
	  (entupd sen)
      ))

   ))
)

;;;;;;;;;;;;;;;;;选择块内实体
(defun block-enty(benty)
  (setq bentyd (entget benty))
  (setq bpol (cdr (assoc 0 bentyd)))
  (if (= bpol "VERTEX")
  (progn
     (setq benty (entnext benty))
     (setq bpol (cdr (assoc 0 bentyd)))
     (while (/= bpol "SEQEND")
     (progn
         (setq benty (entnext benty))
         (setq bentyd (entget benty))
         (setq bpol (cdr (assoc 0 bentyd)))
     ))
     (setq bsenty (cdr (assoc -2 bentyd)))
  )
  (progn
     (setq bsenty benty)
  ))
)

;;;;;;;;;;;;;;填充房屋
(defun c:tcfw ()
(undo_begin)
  (clos)
  (setvar "cmdecho" 1)
  (command "osnap" "none")
  (setq askdst (getreal "请输入填充间距?(3.2 米)"))
  (if (= askdst nil)(setq askdst 3.2))
  (setq ang2 (getreal "角度:(0.0)"))
  (if (= ang2 nil)(setq ang2 0))
  (command "zoom" "extents")
  (if (= askdst nil)
    (progn
      (setq hadist 80.0)
      (setq askdst 80.0)
    )
    (progn
      (setq hadist (* 8 askdst))
    )
  )
  (setq haasmb (ssget "x" (list (cons 0 "hatch") (cons 8 laynm))))
  (command "erase" haasmb "")
  (setq haasmb nil)
  (setq entasmb nil)
  (setq	entasmb(ssget	"x"(list (cons 0 "polyline") (cons 8 laynm))))
  (command "layer" "m" laynm "")
  (setq tmpasmb nil)
  (setq tmpasmb (ssadd))
  (setq i 0)
  (princ "\n 填充中... 请等待.\n")
  (while (< i (sslength entasmb))
    (setq lnent1 nil)
    (setq lnent1 (ssname entasmb i))
    (getaposition)
    (if	(< (length poasmb) 3)
      (command "erase" lnent1 "")
      (progn
	(getmxdist)
	(setq aaa poasmb)
	(setq point1 (nth 0 poasmb)
	      point2 (nth 1 poasmb)
	)
	(setq ptkkk (nth 0 poasmb))
	(setq maxdist 0)
	(setq j 1)
	(while (/= point2 nil)
	  (setq dist (distance point1 point2))
	  (setq dist1 (distance ptkkk point2))
	  (if (> dist maxdist)
	    (progn
	      (setq angl (/ (*(angle point1 point2) 180.0) pi))
	      (setq maxdist dist)
	    )
	  )
	  (setq j (1+ j))
	  (setq point1 point2)
	  (setq point2 (nth j poasmb))
	)
	(setq ang3(+ angl (- 360 ang2)))
	(if (> ang3 360)(setq ang3(- ang3 360)))
	(if (and (> ang3 45) (< ang3 135))
	  (progn
	    (setq angl (- angl 90))
	  )
	  (progn
	    (if	(and (> ang3 225) (< ang3 315))
	      (setq angl (- angl 90))
	    )
	  )
	)
	(if (and (< mxdist1 (* askdst 3)) (< maxdist (* askdst 3)))
	  (setq hadist (* (/ maxdist 2.5) 8))
	  (progn
	    (setq hadist (* askdst 8))
	  )
	)
	(if (> hadist (* askdst 8))
	  (setq hadist (* askdst 8))
	)
	(if (= (ssmemb lnent1 tmpasmb) nil)
	  (progn
	    (setq tmpasmb (ssadd lnent1 tmpasmb))
	    (setq subasmb (ssget "_cp"
				 poasmb
				 (list (cons 0 "polyline")
				       (cons 8 laynm)
				       (cons 70 1)
				 )
			  )
	    )
	    (if	(= subasmb nil)
	      (progn
		(setq subasmb (ssadd))
		(setq subasmb (ssadd lnent1 subasmb))
	      )
	      (progn
		(setq subasmb (ssadd lnent1 subasmb))
	      )
	    )
	    (setq haasmb (ssget	"_cp"
				poasmb
				(list (cons 0 "hatch") (cons 8 laynm))
			 )
	    )
	    (command "erase" haasmb "")
	    (command "bhatch" "s" subasmb "" "p" "ansi31" hadist angl "")
	    (setq k 0)
	    (while (< k (sslength subasmb))
	      (setq lnent1 (ssname subasmb k))
	      (setq tmpasmb (ssadd lnent1 tmpasmb))
	      (setq k (1+ k))
	    )
	  )
	  (progn
	    (princ "\n Be Hatched!!")
	  )
	)
      )
    )
    (setq i (1+ i))
  )
  (print "房屋已填充!" )
  (princ)
  (undo_end)
)


(defun clos()
  (setvar "cmdecho" 0)
  (command "osnap" "none")
  (setq laynm (getstring "请输入要处理的层:"))
  (princ "\n Procissing... Please Wait.\n")
  (setq entasmb (ssget "x" (list (cons 0 "polyline") (cons 8 laynm))))
  (setq i 0)
  (while (< i (sslength entasmb))
    (setq lnent1 nil)
    (setq lnent1 (ssname entasmb i))
    (getaposition)
    (setq ent2 (entget lnent1))
    (if	(/= (rem (cdr (assoc 70 ent2)) 2) 1)
      (progn
	(if (< (distance (car poasmb) (last poasmb)) 0.5)
	  (progn
	    (setq ent2 (subst (cons 70 1) (assoc 70 ent2) ent2))
	    (entmod ent2)
	    (entupd lnent1)
	  )
	)
      )
      (progn
	(setq ent2 (subst (cons 70 1) (assoc 70 ent2) ent2))
	(entmod ent2)
	(entupd lnent1)
      )
    )
    (setq i (1+ i))
  )
  (setq	i nil
	entasmb	nil
  )
)
(defun getaposition ()
  (setq poasmb nil)
  (setq suben1 (entnext lnent1))
  (setq suben2 (entget suben1))
  (setq nameid (cdr (assoc 0 suben2)))
  (while (and (/= nameid "SEQEND") (/= suben1 nil))
    (setq suben2 (entget suben1))
    (setq nameid (cdr (assoc 0 suben2)))
    (if	(= (strcase nameid) "VERTEX")
      (progn
	(setq point (cdr (assoc 10 suben2)))
	(setq poasmb (cons point poasmb))
	(setq suben2 nil
	      point nil
	      nameid nil
	)
      )
    )
    (setq suben1 (entnext suben1))
    (setq suben2 (entget suben1))
    (setq nameid (cdr (assoc 0 suben2)))
  )
  (setq suben2 (entget lnent1))
  (setq pt1 (nth 0 poasmb))
  (setq tmpsmb nil)
  (setq tmpsmb (cons pt1 tmpsmb))
  (setq subk 1)
  (while (< subk (length poasmb))
    (setq pt1 (nth subk poasmb))
    (setq jstflg t)
    (setq subi 0)
    (while (< subi (length tmpsmb))
      (if (<= (distance pt1 (nth subi tmpsmb)) 0.1)
	(setq jstflg nil)
      )
      (setq subi (1+ subi))
    )
    (if	(= jstflg t)
      (setq tmpsmb (cons pt1 tmpsmb))
      (setq jstflg t)
    )
    (setq subk (1+ subk))
  )
  (setq poasmb tmpsmb)
  (if (= (rem (cdr (assoc 70 suben2)) 2) 1)
    (progn
      (setq point (last poasmb))
      (setq poasmb (cons point poasmb))
    )
  )
  (setq	suben2 nil
	point nil
  )
  (setq poasmb (reverse poasmb))
  (setq suben1 nil)
)
(defun getmxdist ()
  (setq mxdist1 0)
  (setq mxiiii 0)
  (while (< mxiiii (length poasmb))
    (setq mxpt1 (nth mxiiii poasmb))
    (setq mxkkkk (+ mxiiii 1))
    (while (< mxkkkk (length poasmb))
      (setq mxpt2 (nth mxkkkk poasmb))
      (if (> (distance mxpt1 mxpt2) mxdist1)
	(progn
	  (setq mxdist1 (distance mxpt1 mxpt2))
	  (setq mxangl (angle mxpt1 mxpt2))
	)
      )
      (setq mxkkkk (1+ mxkkkk))
    )
    (setq mxiiii (1+ mxiiii))
  )
)
(defun c:gczj()
(undo_begin)
(setq lla (getstring "输入层名:"))
 (gzg lla)
 (gzk lla)
 (undo_end)
)
;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
(defun gzg(lla)
(setq zg 4)
(setq ss (ssget "x" (list (cons 8 lla) (cons 0 "text"))))
(setq i 0)
(setq len (sslength ss))
(while (< i len)
(setq en (ssname ss i))
(setq ed (entget en))
(setq h40 (assoc 40 ed))
(setq hh40 (cons 40 zg))
(setq ed (subst hh40 h40 ed))
(entmod ed)
(setq i (+ 1 i))
)
)
;;;;;;;;;;;;;;;;;
(defun gzk(lla)
(SETQ WID 0.8)
(setq ss (ssget "x" (list (cons 8 lla) (cons 0 "TEXT"))))
(setq i 0)
(setq len (sslength ss))
(while (< i len)
(progn
  (setq en (ssname ss i))
  (setq ed (entget en))
  (setq h41 (assoc 41 ed))
  (setq hh41 (cons 41 wid))
  (setq ed (subst hh41 h41 ed))
  (entmod ed)
  (setq i (+ 1 i))
))
)

;;;;;;;;;;;;;;;
(defun c:dgxzj()
 (print)
 (setq setqx (entsel "选择一根记曲线:"))
 (setq setxy (cadr setqx))
 (setq setqx (car setqx))
 (setq enqx(entget setqx))
 (setq en0(cdr (assoc 0 enqx)))
 (setq txt "ERROR")
 (if (= en0 "POLYLINE")(setq txt (itoa (fix (cadddr (assoc 10 enqx))))))
 (if (= en0 "LWPOLYLINE")(setq txt (itoa (fix (cdr (assoc 38 enqx))))))
 (setq txtfx (getorient setxy "\n请指定方向;"))
 (setq setxy(polar setxy (+ 1.6 txtfx) -2))
 (setq txtfx(/(* txtfx 180) 3.1415926))
 (command "layer" "m" "曲线注记" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (command "_text" setxy txtfx txt)
 (princ)
)
(defun c:ybjmd()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "一般居民地" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入文字:"))
 (command "_text" setxy 0 txt )
)
(defun c:szzj()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "数字注记" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入数字:"))
 (command "_text" setxy 0 txt )
)
(defun c:smzj()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "说明注记" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入文字:"))
 (command "_text" setxy 0 txt )
)
(defun c:xzzj()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "乡镇" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入文字:"))
 (command "_text" setxy 0 txt )
)
(defun c:fmzj()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "附名" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入文字:"))
 (command "_text" setxy 0 txt )
)
(defun c:jdzj()
 (setq setxy (getpoint "\n 输入位置:"))
 (command "layer" "m" "界端注记" "" )
 (command "style" "STANDARD" "rs,hztxt" "0" "0.75" "0" "n" "n" "n")
 (setq txt (getstring "\n输入文字:"))
 (command "_text" setxy 0 txt )
)
;;;检查曲线值
(defun c:jcqxz()
(setq rcKey nil)
(setq rckey1 "jcqxz1")
(while (not (eq rcKey "eXit"))
(progn
 (initget 128 "jcqxz1 jcqxz2 eXit")
 (print)
 (setq rcKey (getkword "起点在高处[1]/起点在低处[2]/退出[X] 右键继续:"))
 (if (eq rcKey nil)(setq rckey rckey1)(setq rckey1 rckey))
 (cond
 ((eq rcKey "jcqxz1") (jcqxz1)); (princ "\n起点在高处[1]:\n"))
 ((eq rcKey "jcqxz2") (jcqxz2)); (princ "\n起点在低处[2]:\n"))
 (t nil)
 );;;cond
 )
 (princ)
 )
)
(defun jcqxz2()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(print)
(setq p1(getpoint "低处"))
(print)
(setq p2(getpoint p1 "高处"))
(print)
(setq ck (ssget "F" (list p1 p2 )))
(setq ss -1)
(setq ys 3)
(setq gc nil)
(while (= gc nil)
 (setq ss(+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (print cm)
 (if (or (= cm jc_jqx)(= cm jc_sqx))
 (progn
  (command "_change" ck1 "" "p" "c" ys "")
  (setq lin-list (get-line-list ck1))
  (setq gc(nth 2 (nth 1 lin-list)))
  (print gc)
  (princ "a")
  ));;endif
) 
(repeat (- (sslength ck) (+ ss 1))
 (setq ss (+ ss 1))                
   (setq ys 3)
   (setq ck1(ssname ck ss))
   (setq cm(cdr (assoc 8 (entget ck1)))) 
  (if (or (= cm jc_jqx)(= cm jc_sqx))
  (progn
   (setq lin-list (get-line-list ck1))
   (setq gc1(nth 2 (nth 1 lin-list)))
   (setq gc(+ gc jc_dgj))
   (print gc1)
   (princ "b")
   (if (/= gc1 gc)(setq ys 1))
   ;(command "_change" ck1 "" "p" "e" gc "")
   (command "_change" ck1 "" "p" "c" ys "")
   )))
(princ)
)
(defun jcqxz1()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(print)
(setq p1(getpoint "高处"))
(print)
(setq p2(getpoint p1 "低处"))
(print)
(setq ck (ssget "F" (list p1 p2 )))
(setq ss -1)
(setq ys 3)
(setq gc nil)
(while (= gc nil)
 (setq ss(+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (if (or (= cm jc_jqx)(= cm jc_sqx))
 (progn
  (command "_change" ck1 "" "p" "c" ys "")
  (setq lin-list (get-line-list ck1))
  (setq gc(nth 2 (nth 1 lin-list)))
  (print gc)
  ));;endif
) 
(repeat (- (sslength ck) (+ ss 1))
 (setq ss (+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (if (or (= cm jc_jqx)(= cm jc_sqx))
  (progn
  (setq gc(- gc jc_dgj))
  (setq ys 3)
  (setq lin-list (get-line-list ck1))
  (setq gc1(nth 2 (nth 1 lin-list)))
  (if (/= gc1 gc)(setq ys 1))
  ;(command "_change" ck1 "" "p" "e" gc "")
  (print gc1)
  (command "_change" ck1 "" "p" "c" ys "")         
 )) 
)
(princ)
)

;;;;桥
(defun c:sxq()
(setq en(car (entsel "/选择直线:")))
(while (/= en nil)
 (setq en-list(get-line-list en))
 (setq list1(car en-list))
 (setq list2(nth (- (length en-list) 1) en-list)) 
 (setq pt(angle list1 list2))
 (setq list11(polar list1 (+ 2.356 pt) 4))
 (setq list22(polar list2 (+ 0.785 pt) 4))
 (command "layer" "m" "4620" "" )
 (command "pline" list11 list1 list2 list22 "")
 (command "erase" en "")
 (setq en(car (entsel "选择直线:")))
 (print)
)
)
(defun c:dxq()
(setq en(car (entsel "选择一直线:")))
(setq en-list(get-line-list en))
(setq list1(car en-list))
(setq list2(nth (- (length en-list) 1) en-list)) 
(setq pt(angle list1 list2))
(setq list11(polar list1 (+ 2.356 pt) 2.5))
(setq list22(polar list2 (+ 0.785 pt) 2.5))
(setq list111(polar list1 (+ 3.93 pt) 2.5))
(setq list222(polar list2 (+ 5.5 pt) 2.5))
(command "layer" "m" "4642" "" )
(command "pline" list11 list1 list111 "")
(command "pline" list22 list2 list222 "")
(command "pline" list1 list2 "")
(command "erase" en "")
(print)
)
;;;;;
(defun c:TXT1();;;;备注；；；
(print)
 ;(print " 内部道路：虚线--实线1，空格1，线宽0.15 ") 
 
 (print)
 )
;;获得线的节点表
;;{get-line-list 实体名(Type:"LWPOLYLINE" OR "POLYLINE")};
;;返回3D   line-list ,line-elev ,ames-plnclose=1 close
(defun get-line-list (line-en-name / line-name-list line-type)
  (setq ames-plnclose 0)
  (setq line-name-list (entget line-en-name))
  (setq line-type (cdr (assoc 0 line-name-list)))
  (cond
    ((= line-type "LWPOLYLINE") (get-lwpl-List line-en-name)) 
    ((= line-type "POLYLINE")   (get-pl-List line-en-name))   
    (T (prompt "\n此实体不是多义线!") (setq line-list nil) (setq line-elev nil) (*error*)) 
  );endcond
);end get-line-list
;获得LWPOLYLINE线节点表
(defun get-lwpl-List(line-en-name / line-name-list list-length
                      pt1  p10  ptx  pty ptz pt   I  m kk) 
  (setq line-name-list (entget line-en-name))
  (setq list-length (length line-name-list))
  (setq line-list nil)
  (setq line-elev (cdr (assoc 38 line-name-list)))
    (setq d70 (cdr (assoc 70 line-name-list)))
  (setq I 0	m 0)
(while (< m 20)
        (progn
      (setq kk (car (nth m line-name-list)))
  (if (= kk 10)
      (progn
   (setq i m)
   (setq m 21)
  ))
     (setq m (+ 1 m))
))
(while (< i list-length)
	(progn
	(setq pt1  (nth i line-name-list))
	(setq p10 (nth 0 pt1))
      (if (= p10 10)
	(progn
	(setq ptx (nth 1 pt1))
	(setq pty (nth 2 pt1))
	(setq ptz line-elev)
	(setq pt (list ptx pty ptz))
	(setq line-list (cons pt line-list))
       ))
	(setq i (+ 4 i))
))
(IF (OR (= D70 1) (= D70 9))
(PROGN
   (SETQ line-list (CONS (LAST line-list) line-list))
   (setq ames-plnclose 1)
))
(setq line-list (reverse line-list))
);end get-lwpl-List
;获得POLYLINE线节点表
(defun get-pl-List (line-en-name / line-name-list list-length  vertex-name vertex-prop 
	                           vertex-list ptx  pty ptz pt) 
  (setq line-list nil)
  (setq vertex-list (entget line-en-name))
  (setq d70 (cdr (assoc 70 vertex-list)))
  (setq vertex-name (entnext line-en-name))
  (setq vertex-list (entget vertex-name))
  (setq line-elev (nth 3 (assoc 10 vertex-list)))
  (setq vertex-prop (cdr (assoc 0 vertex-list)))
  (while (/= vertex-prop "SEQEND")
    (setq pt (cdr (assoc 10 vertex-list)))
    (if (/= pt nil)
      (progn
        (setq ptx (nth 0 pt))
        (setq pty (nth 1 pt))
        (setq ptz (nth 2 pt))
        (setq pt (list ptx pty ptz))
        (setq line-list (cons pt line-list))
       );endprogn
     );endif
    (setq vertex-name (entnext vertex-name))
    (setq vertex-list (entget vertex-name))
    (setq vertex-prop (cdr (assoc 0 vertex-list)))
   );endwhile
(IF (OR (= D70 1) (= D70 9))
(PROGN
   (SETQ line-list (CONS (LAST line-list) line-list))
   (setq ames-plnclose 1)
))
  (setq line-list (reverse line-list))
);end get-pl-List
 
 ;;;;
(DEFUN C:72b()
(undo_begin)
        (setq sblip (getvar "blipmode"))
	(setq scmde (getvar "cmdecho"))
	(setvar "blipmode" 0)
	(setvar "cmdecho" 0)
  (setvar "cmdecho" 0)
  (setvar "aunits" 3)
(if (= jieshi "0") 
 (progn
   (SETQ enn '((-4 . "<OR")
	  	(0 . "POLYLINE")
	  	(0 . "LWPOLYLINE")					
               (-4 . "OR>"))
   )
   (prompt "\n选择基线:  ")
   (setq sssel (ssget enn))
   )  
 (progn
  (setq SsSel (ssget "x" '((-4 . "<or") (0 .  "POLYLINE") (0 . "LWPOLYLINE")(-4 . "or>")(8 .  "5220"))))
 ) 
) 
	(command "layer" "m" "5220_SYM" "c" "4" "" "")
  (if (/= SsSel nil)
   (progn
    (setq SsLen (sslength SsSel))
    (setq T -1)
    (while (/= t (- SsLen 1))
     (setq T (+ T 1))
     (a72b_a (ssname SsSel T))
    )
  ))
  (setvar "aunits" 0)
(undo_end)
)
(defun a72b_a(en)
	(setq en-list(get-line-list en))
	(setq en-s(length en-list))
        (setq ii 1.0)
         (setq j 1)
	(setq d1 (* 0.004 wwblc))
	(setq d2 (* 0.001 wwblc))
        (setq d3 (* 0.008 wwblc))
	(SETQ D D1)
	(setq kk 1)
	(setq pc(nth 0 en-list))
	(setq dc(nth 1 en-list))
	(setq ss 1)
	(WHILE (/= ss en-s)
		(SETQ km (distance pc dc))
		(setq ang (angle pc dc))
		(while (>= km d)
                        (setq ii ( + ii 1))
			(setq am (polar pc ang d))
                        (setq df d)
			(if (= kk 1)
				(progn(command "pline" pc am ""))
				)
			(setq km (- km d))
			(if (= kk 1)
				(progn(setq kk 2)
                                             (progn
                     				(setq d d2))
                                   )
				(progn(setq kk 1)
              	                     (if (= (fix (/ ii 3.0)) (/ ii 3.0))                              
                                                (progn  
                                                            (setq d  d3)
                                                 (setq pcs pc) 
                                                  (setq pc1 (polar pc ang (+ d3 2)))
                                                  (setq pc2 (polar pc ang 2))
                                                  (setq pcs pc2) 
                                                     )   
                                              (progn (setq j (+ j 1)) 
                                                      (setq pcy pc)
                                                     (setq d d1)))
                                 )
       				)
                      (if (and  (= kk 1) (= (fix (/ (- ii 1) 3.0)) (/ (- ii 1) 3.0)))                                
                            (progn (setq pc3 pc)
                                    (command "donut" "0" "1" pcs "")))
                   (if (and  (= kk 1) (= (fix (/ j 2.0)) (/ j 2.0)))                                
                            (progn (command "donut" "0" "1" pcy "")))
			(setq pc am)
			)
		(if (= kk 1)
			(progn(command "pline" pc dc ""))
			)
		(setq d (- d km))
		(setq pc dc)
		(setq ss(+ ss 1))
		(setq dc(nth ss en-list))
	)
	(setvar "blipmode" sblip)
	(setvar "cmdecho" scmde)
)
;;;
(DEFUN C:445()
(undo_begin)
       (setq sblip (getvar "blipmode"))
	(setq scmde (getvar "cmdecho"))
	(setvar "blipmode" 0)
	(setvar "cmdecho" 0)
	(command "layer" "m" "2460_SYM" "c" "4" "" "")
  (if (= jieshi "1")
 (PROGN
  (setq enss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2460"))))
  (if (= enss nil)(PROGN(print "找不到 2460 ！")(exit)))
  (setq len (sslength enss))
  (setq s -1)
  (WHILE (/= s (- len 1))
   (setq s(+ s 1))
    (setq en (ssname enss s))
    (a445_a en)
  );endwhile
 )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
   (a445_a en)
  ));endif 
  (command "layer" "f" "2460" "")
(undo_end)	
)	
(DEFUN a445_a(en)
	(setq en-list(get-line-list en))
	(setq en-s(length en-list))
	(SETQ D1 (* 0.01 wwblc))
	(SETQ D D1)
	(SETQ D2 (* 0.001 wwblc))
	(setq pc(nth 0 en-list))
	;(SETQ PC (GETPOINT "\n  Frome point:" ))
	(SETQ X0 (CAR PC))
	(SETQ Y0 (CADR PC))
	(SETQ XA X0)
	(SETQ YA Y0)
	(setq ss 1)
	(setq dc(nth 1 en-list))
	;(SETQ DC (GETPOINT "\n To point:" ))
	(IF (= DC NIL)
		(PROGN(SETQ KK 1))
		(progn(setq kk 0)
		(SETQ X1 (CAR DC))
		(SETQ Y1 (CADR DC))
                )
		)
	(SETQ KP 1)
	(WHILE (/= KK 1)
		(SETQ KM (DISTANCE (LIST X0 Y0) (LIST X1 Y1)))
		(IF (< KM D)
			(PROGN(SETQ D (- D KM))
			(SETQ KP 1)
			(SETQ X0 X1)
			(SETQ Y0 Y1)
			(SETQ XB X0)
			(SETQ YB Y0)
			(COMMAND "LINE" (LIST XA YA) (LIST XB YB) "")
			(SETQ XA XB)
			(SETQ YA YB)
			)
			(PROGN(SETQ HS D)
			(SETQ X (+ X0 (* HS (/ (- X1 X0) KM))))
			(SETQ Y (+ Y0 (* HS (/ (- Y1 Y0) KM))))
			(SETQ XB (- X (* D2 (/ (- X1 X0) KM))))
			(SETQ YB (- Y (* D2 (/ (- Y1 Y0) KM))))
			(SETQ XC1 (- X (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ YC1 (- Y (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ XC2 (+ X (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ YC2 (+ Y (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ XE1 (- X (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ YE1 (+ Y (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ XE2 (+ X (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ YE2 (- Y (* (/ D2 2) (/ (- X1 X0) KM))))
			(COMMAND "LINE" (LIST XA YA) (LIST XB YB) "")
			(COMMAND "LINE" (LIST XC1 YC1) (LIST XC2 YC2) "")
			(COMMAND "LINE" (LIST XE1 YE1) (LIST XE2 YE2) "")
			(SETQ XA (+ X (* D2 (/ (- X1 X0) KM))))
			(SETQ YA (+ Y (* D2 (/ (- Y1 Y0) KM))))
			(SETQ X0 X)
			(SETQ Y0 Y)
			(SETQ D D1)
			(SETQ KP 0)
			)
		)
		(IF (= KP 1)
		         (PROGN
		          (setq ss(+ ss 1))
		          (setq dc(nth ss en-list))
			;(PROGN(SETQ DC (GETPOINT "\n To point:" ))
			
			(IF (= ss en-s)
				(PROGN(SETQ KK 1)
				(COMMAND "LINE" (LIST XA YA) (LIST X1 Y1) "")
				)
				(PROGN(SETQ X1 (CAR DC))
				(SETQ Y1 (CADR DC))
				))
			))
	)
	(setvar "blipmode" sblip)
	(setvar "cmdecho" scmde)
)

(DEFUN C:446()
(undo_begin)
       (setq sblip (getvar "blipmode"))
	(setq scmde (getvar "cmdecho"))
	(setvar "blipmode" 0)
	(setvar "cmdecho" 0)
	(command "layer" "m" "2470_SYM" "c" "4" "" "")
  (if (= jieshi "1")
 (PROGN
  (setq enss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2470"))))
  (if (= enss nil)(PROGN(print "找不到 2470 ！")(exit)))
  (setq len (sslength enss))
  (setq s -1)
  (WHILE (/= s (- len 1))
   (setq s(+ s 1))
    (setq en (ssname enss s))
    (a445_a en)
  );endwhile
 )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
   (a445_a en)
  ));endif 
  (command "layer" "f" "2470" "")
(undo_end)	
)
(DEFUN a446_a(en / ss)
	(setq en-list(get-line-list en))
	(setq en-s(length en-list))
	(SETQ D (* 0.002 wwblc))
	(SETQ D2 (* 0.001 wwblc))
	(SETQ D3 (* 0.0006 wwblc))
	(setq pc(nth 0 en-list))
	;(SETQ PC (GETPOINT "\n  Frome point:" ))
	(SETQ X0 (CAR PC))
	(SETQ Y0 (CADR PC))
	(COMMAND "CIRCLE" (LIST X0 Y0) (/ D3 2))
	(setq ss 1)
	(setq dc(nth 1 en-list))
	;(SETQ DC (GETPOINT "\n To point:" ))
	(IF (= DC NIL)
		(PROGN(SETQ KK 1)
			)
		(PROGN(SETQ X1 (CAR DC))
		(SETQ Y1 (CADR DC))
		(setq kk 0)
		))
	(SETQ KW 2)
	(SETQ D4 D3)
	(WHILE (/= KK 1)
		(SETQ KM (DISTANCE (LIST X0 Y0) (LIST X1 Y1)))
		(IF (< KM D)
			(PROGN(SETQ D (- D KM))
			(SETQ KP 1)
			(SETQ X0 X1)
			(SETQ Y0 Y1)
			)
			(PROGN(SETQ HS D)
			(SETQ X (+ X0 (* HS (/ (- X1 X0) KM))))
			(SETQ Y (+ Y0 (* HS (/ (- Y1 Y0) KM))))
			(COMMAND "CIRCLE" (LIST X Y) (/ D4 2))
			(SETQ X0 X)
			(SETQ Y0 Y)
			(SETQ KW (+ KW 1))
			(IF (> KW 3)
				(PROGN(SETQ KW 1)
				(SETQ D (* 0.002 wwblc))
				(SETQ D4 D3)))
			(IF (= KW 2)
				(PROGN(SETQ D (* 0.002 wwblc))
				(SETQ D4 D3)))
			(IF (= KW 3)
				(PROGN(SETQ D (* 0.002 wwblc))
				(SETQ D4 D2)))
			(SETQ KP 0)
			)
		)
		(IF (= KP 1)
			;(PROGN(SETQ DC (GETPOINT "\n To point:" ))
			(PROGN
			 (setq ss(+ ss 1))
			 (setq dc(nth ss en-list))
			(IF (= ss en-s)
				(PROGN(SETQ KK 1)
				)
				(PROGN(SETQ X1 (CAR DC))
				(SETQ Y1 (CADR DC))
				))
			))
	)
	(setvar "blipmode" sblip)
	(setvar "cmdecho" scmde)
)
(DEFUN c:447()
(undo_begin)
	(setq sblip (getvar "blipmode"))
	(setq scmde (getvar "cmdecho"))
	(setvar "blipmode" 0)
	(setvar "cmdecho" 0)
	(command "layer" "m" "2480_SYM" "c" "4" "" "")
(if (= jieshi "1")
 (PROGN
  (setq enss (ssget "x" '((-4 . "<OR")(0 . "POLYLINE")(0 . "LWPOLYLINE")(-4 . "OR>") (8 . "2480"))))
  (if (= enss nil)(PROGN(print "找不到 2480 ！")(exit)))
  (setq len (sslength enss))
  (setq s -1)
  (WHILE (/= s (- len 1))
   (setq s(+ s 1))
    (setq en (ssname enss s))
    (a447_a en)
  );endwhile
 )
  (PROGN
  (setq en(car (entsel "\n选择基线:")))
   (a447_a en)
  ));endif 
  (command "layer" "f" "2480" "")
(undo_end)
  );endif 
(DEFUN a447_a(en)
	(setq en-list(get-line-list en))	
	(setq en-s(length en-list))
	(SETQ D1 (* 0.01 wwblc))
	(SETQ D D1)
	(SETQ D2 (* 0.001 wwblc))
	(setq pc(nth 0 en-list))
	;(SETQ PC (GETPOINT "\n  Frome point:" ))
	(SETQ X0 (CAR PC))
	(SETQ Y0 (CADR PC))
	(SETQ XA X0)
	(SETQ YA Y0)
	(setq dc(nth 1 en-list))
	(setq ss 1)
	;(SETQ DC (GETPOINT "\n To point:" ))
	(IF (= DC NIL)
		(PROGN(SETQ KK 1)
		)
		(PROGN(SETQ X1 (CAR DC))
		(SETQ Y1 (CADR DC))
		(SETQ KK 0)
		))
	(WHILE (/= KK 1)
		(SETQ KM (DISTANCE (LIST X0 Y0) (LIST X1 Y1)))
		(IF (< KM D)
			(PROGN(SETQ D (- D KM))
			(SETQ KP 1)
			(SETQ X0 X1)
			(SETQ Y0 Y1)
			(SETQ XB X0)
			(SETQ YB Y0)
			(COMMAND "LINE" (LIST XA YA) (LIST XB YB) "")
			(SETQ XA XB)
			(SETQ YA YB)
			)
			(PROGN(SETQ HS D)
			(SETQ X (+ X0 (* HS (/ (- X1 X0) KM))))
			(SETQ Y (+ Y0 (* HS (/ (- Y1 Y0) KM))))
			(SETQ XB (- X (* D2 (/ (- X1 X0) KM))))
			(SETQ YB (- Y (* D2 (/ (- Y1 Y0) KM))))
			(SETQ XC1 (- X (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ YC1 (- Y (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ XC2 (+ X (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ YC2 (+ Y (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ XH1 (+ X (+ (* (- XC1 X) 0.707) (* (- YC1 Y) 0.707))))
			(SETQ YH1 (+ Y (- (* (- XC1 X) 0.707) (* (- YC1 Y) 0.707))))
			(SETQ XH2 (+ X (+ (* (- XC2 X) 0.707) (* (- YC2 Y) 0.707))))
			(SETQ YH2 (+ Y (- (* (- XC2 X) 0.707) (* (- YC2 Y) 0.707))))
			(SETQ XE1 (- X (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ YE1 (+ Y (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ XE2 (+ X (* (/ D2 2) (/ (- Y1 Y0) KM))))
			(SETQ YE2 (- Y (* (/ D2 2) (/ (- X1 X0) KM))))
			(SETQ XG1 (+ X (+ (* (- XE1 X) 0.707) (* (- YE1 Y) 0.707))))
			(SETQ YG1 (+ Y (- (* (- XE1 X) 0.707) (* (- YE1 Y) 0.707))))
			(SETQ XG2 (+ X (+ (* (- XE2 X) 0.707) (* (- YE2 Y) 0.707))))
			(SETQ YG2 (+ Y (- (* (- XE2 X) 0.707) (* (- YE2 Y) 0.707))))
			(COMMAND "LINE" (LIST XA YA) (LIST XB YB) "")
			(COMMAND "LINE" (LIST XH1 YH1) (LIST XH2 YH2) "")
			(COMMAND "LINE" (LIST XG1 YG1) (LIST XG2 YG2) "")
			(SETQ XA (+ X (* D2 (/ (- X1 X0) KM))))
			(SETQ YA (+ Y (* D2 (/ (- Y1 Y0) KM))))
			(SETQ X0 X)
			(SETQ Y0 Y)
			(SETQ D D1)
			(SETQ KP 0)
			)
		)
		(IF (= KP 1)
		      (PROGN
		         (setq ss(+ ss 1))
			 (setq dc(nth ss en-list))
			;(PROGN(SETQ DC (GETPOINT "\n To point:" ))
			(IF (= ss en-s)
				(PROGN(SETQ KK 1)
				(COMMAND "LINE" (LIST XA YA) (LIST X1 Y1) "")
				)
				(PROGN(SETQ X1 (CAR DC))
				(SETQ Y1 (CADR DC))
				))
			))
	)
	(setvar "blipmode" sblip)
	(setvar "cmdecho" scmde)
)
;;;;;;;;************修线
(defun c:Edpln()
(undo_begin)
(setvar "plinewid" 0)
(setq cla (getvar "Clayer"))
(setq delenLt nil addLt nil Ltqxn nil)
(princ "\n曲线编辑[画线]:\n")
(princ ">>")
(setq tp 0)
(while (not (or (= tp "POLYLINE") (= tp "LWPOLYLINE") (= tp "LINE")))
(setq qx1 (entsel "选择一根线(起始点):"))
(if (/= qx1 nil)
(progn
(setq en1 (car qx1))
(setq tp (cdr (assoc 0 (entget en1))))
)
(setq tp "POLYLINE")
)
)
(if (/= qx1 nil)
(progn
(setq en1 (car qx1))
(setq qsd (cadr qx1))
(setq endel en1)
(redraw en1 3)
(setq ed (entget en1))
(setq zzz (nth 3 (assoc 10 ed)))
(setq en1wid (cdr (assoc 40 ed)))
(if (= zzz 0.0)
(progn
(setq edzzz (entget (entnext en1)))
(setq zzz (nth 3 (assoc 10 edzzz)))
))
(setq enlay (assoc 8 ed))
(setq enlay (cdr enlay))
(command "layer" "m" enlay "")
(princ "\n画线:")
(setq xyd qsd)
(setq qyd qsd)
(setq addlt (cons qsd addlt))
(while (/= xyd nil)
(progn
(princ "\n[")
(princ zzz)
(setq xyd (getpoint qyd "]画下一点[右键结束]:"))
(if (/= xyd nil)
(progn
(command "line" qyd xyd "")
(setq ena (entlast))
(setq delenLt (cons ena delenLt))
(setq qyd xyd)
(setq jsd xyd)
(setq xydx (nth 0 xyd))
(setq xydy (nth 1 xyd))
(setq xyd (list xydx xydy))
(setq addlt (cons xyd addlt))
))
))
(redraw en1 4)
(setq addlt (reverse addlt))
(setq qsdx (nth 0 qsd))
(setq qsdy (nth 1 qsd))
(setq qsd (list qsdx qsdy))
(setq jsdx (nth 0 jsd))
(setq jsdy (nth 1 jsd))
(setq jsd (list jsdx jsdy))

(if (/= delenLt nil)
(progn
(setq Delen (Length delenLt))
(setq Deln 0)
(while (< deln delen)
(progn
(setq delent (nth deln delenLt))
(command "erase" delent "")
(setq Deln (+ 1 deln))
))
(redraw en1 4)
(get-line-list en1)
(edplnaddbiao line-list addlt qsd jsd line-elev)
(if (/= en1wid 0.0)
(setvar "plinewid" en1wid)
)
(Draw_Pln_lt lt)
(command "erase" endel "")
))
(command "layer" "m" cla "")
))
(setvar "plinewid" 0)
(undo_end)
)
(defun undo_begin()
(if (equal 0 (getvar "UNDOCTL")) ;Make sure undo is fully enabled.
       (command "_.undo" "_all")
   )
   (if (or (not (equal 1 (logand 1 (getvar "UNDOCTL"))))  
           (equal 2 (logand 2 (getvar "UNDOCTL")))
       );or
       (command "_.undo" "_control" "_all") 
   )
(command "undo" "begin")
)
(defun undo_end()
(command "undo" "end")
)
(defun Draw_Pln_lt(Plt / i pf len pto)
(if (/= Plt nil)
(progn
(setq i 0)
(setq pf (nth i Plt))
(setq len (length Plt))
(if (= Is_3Dpln 1)
(command "3dpoly" pf)
(command "pline" pf)
)
(setq i 1)
(while (< i len)
(setq pto (nth i Plt))
(command pto)
(setq i (+ 1 i))
)
(command "")
))
)
(defun EDPLnaddbiao(enlt addlt p1 p2 enz / pt)
(SETVAR "CMDECHO" 0)
(setq Isenadd 1)
;;;;;
(setq EnLen (length enlt))
(setq n 0)
(setq min1 1000)
(setq min2 1000)
(while (< n Enlen)
(progn
(setq pt (nth n enlt))
(setq ds1 (distance pt p1))
(setq ds2 (distance pt p2))
(if (< ds1 min1)
(progn
(setq min1  ds1)
(setq the1 n) 
))
(if (< ds2 min2)
(progn
(setq min2  ds2)
(setq the2 n) 
))
(setq n (+ 1 n))
))
;;;;
(if (> the1 the2)
(progn
(setq addlt (reverse addlt))
(setq thetmp the1)
(setq the1 the2)
(setq the2 thetmp)
))
;;;;
(setq lt nil)
(setq n 0)
(while (< n Enlen)
(progn
;;
(if (or (< n the1) (> n the2))
(progn
(setq pt (nth n enlt))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq pt (list ptx pty enz))
(setq lt (cons pt lt))
)
(progn
(if (= isenadd 1)
(progn
(setq m 0)
(setq addltlen (length addlt))
(while (< m addltlen)
(progn
(setq pt (nth m addlt))
(setq ptx (nth 0 pt))
(setq pty (nth 1 pt))
(setq pt (list ptx pty enz))
(setq lt (cons pt lt))
(setq m (+ 1 m))
))
(setq isenadd 0)
))
)
)
;;
(setq n (+ 1 n))
))
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun EdPlnaddLt(Plt)
(if (/= Plt nil)
(progn
(setq i 0)
(setq pf (nth i Plt))
(setq len (length Plt))
(command "pline" pf)
(setq i 1)
(while (< i len)
(progn
(setq pto (nth i Plt))
(command pto)
(setq i (+ 1 i))
))
(command "")
))
;(setq plt nil)
;(setq enn1 (entlast))
;(command "pedit" enn1 "w" itW "")
(princ)
)

;;;;;;;;;;;;*
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;断线连接;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lj(/ ssent ppent e1 ek1 p1 e2 ek2 p2 sslen ssn ptzd
                    pk11 pk12 pk21 pk22	ltk1 ltk2 d11 d12 d21 d22 QzPLJoin  
		    en1z en2z pt1x pt1y pt1z pt2x pt2y pt2z edk c10 c10n RetYN)
(setq *error* myerr)
(princ "\n曲线连接:\n")
(setq Ssent nil)
(setq Ppent nil)
(setq e1 "xxx")
(while (/= e1 nil)
(progn
(print)
(setq E1 (entsel "选择第一根线[右键结束]:"))
(if (/= e1 nil)
(progn
(setq ek1 (car e1))
(setq p1 (cadr e1))
(REDRAW Ek1 3)
(print)
(SETQ E2 (ENTSEL "选择第二根线:"))
(REDRAW Ek1 4)
(if (/= e2 nil)
(progn
(setq ek2 (car e2))
(setq p2 (cadr e2))
(setq ssent (cons ek1 ssent))
(setq ssent (cons ek2 ssent))
(setq Ppent (cons p1 PPent))
(setq Ppent (cons p2 PPent))
))
))
))
(setq ssLen (length ssent))
(setq ssn 0)
(setq ssent (reverse ssent))
(setq ppent (reverse PPent))
(while (< ssn sslen)
(progn
(setq ek1 (nth ssn ssent))
(setq enj ek1)
(setq p1 (nth ssn PPent))
(setq ssn (+ 1 ssn))
(setq ek2 (nth ssn Ssent))
(setq p2 (nth ssn Ppent))
(setq ssn (+ 1 ssn))
(if (eq ek1 ek2)
(progn
(command "pedit" ek1 "c" "x")
)
(progn
(get-line-list ek1)
(setq ltk1 line-list)
(setq en1z line-elev)
(get-line-list ek2)
(setq ltk2 line-list)
(setq en2z line-elev)
(setq QzPLJoin 0)
(setq dz12 (- en1z en2z))
(setq dz12 (abs dz12))
(if (> dz12 0.001)
(progn
(princ "\n高程值不相等,要强制连结吗？(Y/N)<N>")
(setq RetYN (getstring))
(setq RetYN (strcase RetYN))
(if (= RetYN "Y")
(setq QzPLJoin 1)
)
))
(if (or (< dz12 0.001) (= QzPLJoin 1))
(progn
(setq pk11 (nth 0 ltk1))
(setq pk12 (nth (- (length ltk1) 1) ltk1))
(setq pk21 (nth 0 ltk2))
(setq pk22 (nth (- (length ltk2) 1) ltk2))
(setq d11 (distance p1 pk11))
(setq d12 (distance p1 pk12))
(setq d21 (distance p2 pk21))
(setq d22 (distance p2 pk22))
(if (> d11 d12)
 (setq ltk1 (reverse ltk1))
)
(if (< d21 d22)
 (setq ltk2 (reverse ltk2))
)
(setq pk11 (nth 0 ltk1))
(setq pk22 (nth (- (length ltk2) 1) ltk2))
(setq pt1x (nth 0 pk11))
(setq pt1y (nth 1 pk11))
(setq pt1z (nth 2 pk11))
(setq pt2x (nth 0 pk22))
(setq pt2y (nth 1 pk22))
(setq pt2z (nth 2 pk22))
(setq pz12 (- pt1z pt2z))
(setq pz12 (abs pz12))
(setq ptzdx (/ (+ pt1x pt2x) 2))
(setq ptzdy (/ (+ pt1y pt2y) 2))
(setq Ptzd (list ptzdx ptzdy pt1z))
(setq ltk1 (cons ptzd ltk1))
(and-list ltk1 ltk2)
(ames-PlnList and-lt)
(get-attrib enj)
(set-attrib (entlast))
(COMMAND "erase" ek1 "")
(COMMAND "erase" ek2 "")
))
));;
))
)

(defun and-List(lt1 lt2 / i len1 xyz)
 (setq i 0)
 (setq len1 (length lt1))
 (setq lt2  (reverse lt2))
 (while (< i len1)
 (progn
 (setq xyz (nth i lt1))
 (setq lt2 (cons xyz lt2))
  (setq i (+ 1 i))
 ))
 (setq and-lt (reverse lt2))
)
(defun ames-PlnList(Plt / pf len i pto)
(if (/= Plt nil)
(progn
(setq i 0)
(setq pf (nth i Plt))
(setq len (length Plt))
(command "pline" pf)
(setq i 1)
(while (< i len)
(progn
(setq pto (nth i Plt))
(command pto)
(setq i (+ 1 i))
))
(command "")
))
(princ)
)
(defun get-attrib(en-name / en-name-list)
;;;;;inint
;(attrib-init)
	(setq en-name-list (entget en-name))
	(setq en-type (cdr (assoc 0 en-name-list)))
	(setq en-color (cdr (assoc 62 en-name-list)))
	(if (or (= en-color 0) (= en-color nil))
	    (setq en-color "BYLAYER")
	)
	(setq en-layer (cdr (assoc 8 en-name-list)))
	(setq en-Thickness (cdr (assoc 39 en-name-list)))
	(setq en-scale (cdr (assoc 48 en-name-list)))
	(setq en-ltype (cdr (assoc 6 en-name-list)))
	(if (= en-ltype nil) (setq en-ltype "BYLAYER"))
  (cond
    ((= en-type "LWPOLYLINE") (get-lwpl-attrib en-name)) 
    ((= en-type "POLYLINE")   (get-pl-attrib en-name))
    ((= en-type "TEXT")       (get-TEXT-attrib en-name)) 
    ((= en-type "INSERT")     (get-insert-attrib en-name))
    (T (prompt "\n不能获得此实体更多属性!") (EXIT))
  );endcond
)
(defun get-lwpl-attrib( en-name / en-name-list width width0)
(setq en-name-list (entget en-name))
(setq en-elev (cdr (assoc 38 en-name-list)))
(setq en-close (cdr (assoc 70 en-name-list)))
(setq width (cdr (assoc 40 en-name-list)))
(setq width0 (cdr (assoc 41 en-name-list)))
(if (equal width width0 0.001)
(setq en-Width width)	
(setq en-Width nil)	
)
)
(defun set-attrib(en-name)
	(if (/= en-Layer nil) (command "change" en-name "" "p" "layer" en-layer ""))
	(if (/= en-Ltype nil) (command "change" en-name "" "p" "ltype" en-ltype ""))
        (if (/= en-Thickness nil) (command "change" en-name "" "p" "Thickness" en-Thickness ""))
        (if (/= en-scale nil) (command "change" en-name "" "P" "ltscale" en-scale ""))
	(if (/= en-elev nil) (command "change" en-name "" "p" "elev" en-elev ""))
	(if (/= en-color nil) (command "change" en-name "" "p" "color" en-color ""))
	(if (/= en-width nil) (command "pedit" en-name "width" en-width ""))
	(if (= en-close 1) (command "pedit" en-name "c" ""))
	(if (/= en-Hight nil)
 	(command "change" en-name "" en-style en-Hight  en-angle en-text "")
	)
	
)
(defun get-pl-attrib( en-name / en-name-list vertex-name
	       		vertex-list  width0 width1)
(setq en-name-list (entget en-name))
(setq en-close (cdr (assoc 70 en-name-list)))
(setq width0 (cdr (assoc 40 en-name-list)))
(setq width1 (cdr (assoc 41 en-name-list)))
(if (equal width0  width1 0.001)
(setq en-Width width0)	
(setq en-Width nil)	
)
 (setq vertex-name (entnext en-name))
 (setq vertex-list (entget vertex-name))
 (setq en-elev (nth 3 (assoc 10 vertex-list)))
)
;;;;;;;;;;;;;;;;;;;;;;;;**
(defun c:kgd();;;块改点
(print "选择需要改的点")
(setq SsSel (ssget ))
(setq s -1)
(setq Len (sslength SsSel))
 (while (/= s (- len 1))
  (setq s(+ s 1))
  (setq en (ssname sssel s))
  (setq ed (entget en))
  (setq la (cdr (assoc 0 ed)))
  (if (= la "INSERT")
   (progn
   (setq la (cdr (assoc 10 ed)))
   (command "point" la)
   (command "erase" en "")
   )
  )
 )
)
(defun c:clgctxt()
(undo_begin)
 (setvar "cmdecho" 0)
 (setq ed8 (getstring "输入层名:"))
 (command "layer" "m" ed8 "c" "32" """")
 (setq ed0 "text") 
 (setq ss0 (ssget "x" (list (cons 8 ed8) (cons 0 ed0))))
 (setq kk (delete_list ss0))
)
(defun delete_list(ss)
 (if (/= ss0 nil)
   (progn
    (setq i 0) 
    (setq j 0)
    (setq sslen0 (sslength ss0))
    (while (< i sslen0)
    (setq ssen (ssname ss0 i))
    (setq ssed (entget ssen))
    (setq ss10 (cdr (assoc 10 ssed)))
    (setq ay (nth 1 ss10))
    (setq ax ( + (nth 0 ss10) 2))
    (setq az (nth 2 ss10))
    (setq ss20 (list ax ay az))
    (setq sstxt1 (cdr (assoc 1 ssed)))
    (command "insert" "hp.dwg" ss10 "" "" "")
    (command "erase" ssen "")
    (setq txt1 (sebstr sstxt1 1 1))
    (if (= txt1 "+")(setq sstxt1 (substr sstxt1 2)))
    (command "text" ss20 4 0 sstxt1)
    (setq i (+ 1 i))
    )
   )
 )
 (undo_end)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;曲线付值
(defun c:qxfz()
(setq rcKey nil)
(setq rckey1 "jcqxz1")
(while (not (eq rcKey "eXit"))
(progn
 (initget 128 "jcqxz1 jcqxz2 eXit")
 (print)
 (setq rcKey (getkword "起点在高处[1]/起点在低处[2]/退出[X] 右键继续:"))
 (if (eq rcKey nil)(setq rckey rckey1)(setq rckey1 rckey))
 (cond
 ((eq rcKey "jcqxz1") (jcqxz1)); (princ "\n起点在高处[1]:\n"))
 ((eq rcKey "jcqxz2") (jcqxz2)); (princ "\n起点在低处[2]:\n"))
 (t nil)
 );;;cond
 )
 (princ)
 )
)
(defun jcqxz2()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(print)
(setq p1(getpoint "低处"))
(print)
(setq p2(getpoint p1 "高处"))
(print)
(setq ck (ssget "F" (list p1 p2 )))
(setq ss -1)
(setq ys 3)
(setq gc nil)
(while (= gc nil)
 (setq ss(+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (print cm)
 (if (or (= cm jc_jqx)(= cm jc_sqx))
 (progn
  (command "_change" ck1 "" "p" "c" ys "")
  (setq lin-list (get-line-list ck1))
  (setq gc(nth 2 (nth 1 lin-list)))
  (print gc)
  ));;endif
) 
(repeat (- (sslength ck) (+ ss 1))
 (setq ss (+ ss 1))                
   (setq ys 3)
   (setq ck1(ssname ck ss))
   (setq cm(cdr (assoc 8 (entget ck1)))) 
  (if (or (= cm jc_jqx)(= cm jc_sqx))
  (progn
   (setq gc(+ gc jc_dgj))
   (print gc)
   (command "_change" ck1 "" "p" "e" gc "")
   (command "_change" ck1 "" "p" "c" ys "")
   )))
(princ)
)
(defun jcqxz1()
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(print)
(setq p1(getpoint "高处"))
(print)
(setq p2(getpoint p1 "低处"))
(print)
(setq ck (ssget "F" (list p1 p2 )))
(setq ss -1)
(setq ys 3)
(setq gc nil)
(while (= gc nil)
 (setq ss(+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (if (or (= cm jc_jqx)(= cm jc_sqx))
 (progn
  (command "_change" ck1 "" "p" "c" ys "")
  (setq lin-list (get-line-list ck1))
  (setq gc(nth 2 (nth 1 lin-list)))
  (print gc)
  ));;endif
) 
(repeat (- (sslength ck) (+ ss 1))
 (setq ss (+ ss 1))
 (setq ck1(ssname ck ss))
 (setq cm(cdr (assoc 8 (entget ck1)))) 
 (if (or (= cm jc_jqx)(= cm jc_sqx))
  (progn
  (setq gc(- gc jc_dgj))
  (setq ys 3)
  (command "_change" ck1 "" "p" "e" gc "")
  (print gc)
  (command "_change" ck1 "" "p" "c" ys "")         
 )) 
)
(princ)
)
;;;;检查点线
(defun c:jcdx()
 (if (= jcdx1 "0")(zdjcdx)(sdjcdx))
)
(defun msgv(pntVEL En1VEL En2VEL)
	(princ "\nPntVEL: ")
	(princ pntVEL)
	(princ " En1VEL: ")
	(princ En1VEL)
	(princ "  En2VEL ")
	(princ En2VEL)
	(princ "\n"))
(defun SetData()
	(setq LaJqx jc_jqx)
	(setq LaSqx jc_sqx)
	(setq LaDian jc_gcd)
	(setq SearchR 80)
	(setq EnAng 0)
	(setq EnDis 0)
	(setq StpAng 23)
	(setq StpDis 0.5)
	(setq StpDis (* StpDis Blc)))
(defun chkd(EnPnt BLC DGj / dv absdv En1VEL En2VEL )
	(SetData)
	(setq dgj (float dgj))
	(setq Pnt (assoc 10 (entget EnPnt)))
	(if (/= Pnt nil)
	(progn
	(setq ptx (nth 1 Pnt))
	(setq pty (nth 2 Pnt))
	(setq Pnt0 (list ptx pty));create point (2d)
	(setq EvlEnpnt (nth 3 Pnt));get point evl
 	(princ EvlEnpnt)
	(setq EvlEnpnt (float EvlEnpnt))
	))
    (setq Do 1)
    (while (= Do 1);0
    (progn
	(setq Done1 1)
	(setq EnDis StpDis)
	(while (= Done1 1)
	(progn
	(setq Pnt1 (polar Pnt0 EnAng EnDis))
	(SETQ SS1 (SSGET "F" (LIST Pnt0 Pnt1)))
	(if (/= SS1 nil)
	(progn
	(SETQ LEN (SSLENGTH SS1))
	(setq n 0)
	(while (< n LEN)
	(progn
	(setq en (ssname SS1 n))
	(setq SS1ed (entget en))
	(SETQ Lay (CDR (ASSOC 8 SS1ED)))
	(if (or (= Lay LaJqx) (= Lay LaSqx))
	(progn
	(setq Done1 0)
	(setq tmppnt pnt1)
	(setq SS1en en)
	(setq n LEN)
	)
	)
	(setq n (+ n 1))
	))
	))
	(if (> EnDis SearchR)
	(progn
	(setq EnAng (+ EnAng StpAng))
		(if (> EnAng (- 360 StpAng))
		(progn
		(setq Done1 2)
		))
	(setq EnDis StpDis)
	))
	(setq EnDis (+ EnDis StpDis))
	)
	)
	(if (= Done1 0)
	(progn
	(setq Done 1)
	(setq EnDis StpDis)
	(while (= Done 1)
	(progn
	(setq pnt2 (polar tmpPnt EnAng EnDis))
	(SETQ SS2 (SSGET "F" (LIST tmpPnt Pnt2)))
	(if (/= SS2 nil)
	(progn
	(SETQ LEN (SSLENGTH SS2))
	(setq n 0)
	(while (< n LEN)
	(progn
	(setq en (ssname SS2 n))
	(setq SS2ed (entget en))
	(SETQ Lay (CDR (ASSOC 8 SS2ED)))
	(if (or (= Lay LaJqx) (= Lay LaSqx))
	(progn
	(setq SS2en en)
	(setq done 0)
	(setq n LEN)
	)
	)
	(setq n (+ n 1))
	))
	))
	(if (> EnDis SearchR)
	(progn
	(setq Done 2)
	(setq do 1)
	))
	(setq EnDis (+ EnDis StpDis))
	)
	)
	))
	(if (= Done 0)
	(progn 
	(setq SS1ED (entnext SS1en))
	(setq SS1ED (entget SS1ED))
	(setq En1VEL (nth 3 (assoc 10 SS1ED)))
	(setq SS2ED (entnext SS2en))
	(setq SS2ED (entget SS2ED))
	(setq En2VEL (nth 3 (assoc 10 SS2ED)))
	(setq En1VEL (float En1VEL))
	(setq En2VEL (float En2VEL))
	(setq adgj (+ En1VEL DGJ))
	(setq jdgj (- En1VEL DGJ))
	(setq dv (- En2VEL En1VEL))
	(setq absdv (abs dv))
	(if (< absdv 0.0001)
	(progn
	(setq dv 0.0)
	(setq absdv 0.0)
	)
	)
	(if  (= 0 absdv)
	(progn 
	(setq Do 1)
	(princ)
	))
	(if (< dv 0)
	(progn 
	(if ( and (> EvlEnpnt En1VEL) (< EvlEnpnt adgj))
	(progn
	(setq Do 0)
	)
	(progn
	(setq Do 3)
	)
	)
))
	(if (> dv 0)
	(progn 
	(if ( and (< EvlEnpnt En1VEL) (> EvlEnpnt jdgj))
	(progn	
	(setq Do 0)
	)
	(progn
	(setq Do 3)
	)
	)
))
	)
	)
	(if (and (> EnAng 360) (= do 1))
	(progn
	(setq Do 2)
	(princ)
	))
	(setq EnAng (+ EnAng StpAng))
	(setq EnDis StpDis)  
	(princ)	
   ))

	(if (= Do 4)
	(progn
	(msgv EvlEnpnt En1VEL En2VEL)
	(command  "layer" "make" "XXXX的点" "color" 5 "" "")
	(command "circle"  Pnt0  (* 5 BLC) "")
	(princ)
	(setq do4 (+ 1 do4))
	))
	(if (= Do 3)
	(progn
	(command  "layer" "make" "错误的点" "color" 1 "" "")
	(command "circle"  Pnt0  (* 5 BLC) "")
	(princ)
	(setq do3 (+ 1 do3))
	))
	(if (= Do 2)
	(progn
	(command  "layer" "make" "不能判断的点" "color" 2 "" "")
	(command "circle"  Pnt0  (* 5 BLC) "")
	(princ)
	(setq do2 (+ 1 do2))
	))
	(if (= Do 0)
	(progn
	(command  "layer" "make" "正确的点" "color" 3 "" "")
	(command "circle"  Pnt0  (* 3 BLC) "")
	(setq do0 (+ 1 do0))
	(princ)
	))
(princ)
)
(defun sdjcdx()
	(SETVAR "CMDECHO" 0)
	(setq p1 (getpoint "选择第一点："))
	(setq p2 (getcorner p1 "选择第二点："))
	(SETQ Pnts (ssget "w" p1 p2))
	(SETQ LENth (SSLENGTH Pnts))
	(princ lenth)
	(setq m 0)
	(while (< m lenth)
	(progn 
	(setq en (ssname Pnts m))
	(princ "判断")
	(princ m)
	(princ "点: ")
	(print)
	(setq ed0 (entget en))
	(SETQ La (CDR (ASSOC 8 ED0)))
	(if(= La "8140")
	(chkd en Blc0 dgj0)
	)
	(setq m (+ m 1))
	(command "pline" pnt0 pnt1 pnt2 "")
	));end while
)
(defun zdjcdx()
	(setq Blc0 (/ wwblc 1000))
	(setq Dgj0 jc_dgj)
	(princ "\n请稍等一会儿......")
	(setq do4 0)
	(setq do3 0)
	(setq do2 0)
	(setq do0 0)
	(SETVAR "CMDECHO" 0)
	(SETQ Pnts (SSGET "x" (list (cons 0 "POINT")(cons 8 jc_gcd))))
	(if (= pnts nil)(SETQ Pnts (SSGET "x" (list (cons 0 "INSERT")(cons 8 jc_gcd)))))
	(if (= pnts nil)(progn(print "找不到高程点！")(exit abort)))
	(SETQ LENth (SSLENGTH Pnts))
	(princ lenth)
	(setq m 0)
	(while (< m lenth)
	(progn 
	(setq en (ssname Pnts m))
	(princ "判断")
	(princ m)
	(princ "点: ")
	(print)
	(setq ed0 (entget en))
	(SETQ La (CDR (ASSOC 8 ED0)))
;	(if(= La LaDian)
	(if(= La "8140")
	(chkd en Blc0 dgj0)
	)
	(setq m (+ m 1))
	))
	(princ "错误点个数：[ ")
	(princ do3)
	(princ " ] 不能判定点个数：[ ")
	(princ do2)
	(princ " ] 正确点个数：[ ")
	(princ do0)
	(princ " ]")
	(princ)
)
;;;;;;;;;;;;;;;;
;内插
(defun dxf(ent i / val)
(setq val (cdr (assoc i (entget ent)))))
(defun sysvarinit()
(setvar "cmdecho" 0)
(setvar "plinetype" 0)
(setvar "luprec" 3)
(setvar "OSMODE" 0))
(sysvarinit)
(if (= Gol_wid nil)
(setq Gol_wid 0.0))
   (setq NcKjwayNI 0)
   (setq sqxlayer "8110")	
   (setq rcQxgs 4)
   (setq LjDis 30.0)
   (setq dges-dgj 2.0)
   (setq rcCs 1 pc_lj 1 NC_BJ_LJ 1)
   (setq DrcCs0 1)
   (setq DrcCs1 1)
   (setq Is_3Dpln 0)
   (setq rcBlc 2)
   (setq qbo_ang1 25.0)
   (setq qbo_ang2 40.0)
   
(defun c:qxnc()
(princ "\n曲线内插:")
(qxnc_xg 0)
)
(defun c:qxxg()
(princ "\n修多根曲线:")
(qxnc_xg 1)
)
(defun qxnc_xg(NC_BJ_LJ)
(setq ed_scale(/ wwblc 1000))
;(setq NC_BJ_LJ 1)
(setq NcKjwayNI 0)
(if (= NcKjwayNI 0)
(NcEd_N)
(NcEd_I)))
(defun NcEd_I()
(ed-qxrcin)
(setq NcKjway 0)
(setq NcKjwayNI 1)
(if (= isedpln_qxnc 1)
(progn
(undo_begin)
(Ed_QxIns lt1 lt2 p1z p2z)
(Ed_Nc_Lj qxncaddent)
(undo_end))))
(defun NcEd_N()
(ed-qxrcin)
(setq NcKjway 0)
(setq NcKjwayNI 0)
(if (= isedpln_qxnc 1)
(progn
(undo_begin)
(Ed_QxNc lt1 lt2 p1z p2z)
(Ed_Nc_Lj qxncaddent)
(undo_end))))
(defun ed-qxrcin( / rc_qxgs pt3 qx1 qx2 en1 qsd1 en2 qsd2 dz dgj rckey)
(setq isedpln_qxnc 0)
(setq pt3 nil)
(setvar "cmdecho" 0)
 (setq Dges-dgj JC_dgj)
(princ "\n曲线根数[")
(princ rcqxgs)
(princ "]:")
(if (= NcKjway 0)
(setq Rc_Qxgs (getint)))
(if (/= Rc_Qxgs nil)
(setq rcQxgs rc_Qxgs))
(princ "\n");;曲线
(setq tp 0)
(while (not (or (= tp "POLYLINE") (= tp "LWPOLYLINE") (= tp "LINE")))
(setq qx1 (entsel "选择第一根线(起始点):"))
(if (/= qx1 nil)
(progn
(setq en11 (car qx1))
(setq tp (dxf en11 0)))
(setq tp "POLYLINE")))
(if (/= qx1 nil)
(progn
(setq en1 (car qx1))
(setq qsd1 (cadr qx1))
(redraw en1 3)
(print)
(setq tp 0)
(while (not (or (= tp "POLYLINE") (= tp "LWPOLYLINE") (= tp "LINE")))
(setq qx2 (ENTSEL "\n选择第二根线(起始点):"))
(if (/= qx2 nil)
(progn
(setq en22 (car qx2))
(setq tp (dxf en22 0)))
(setq tp "POLYLINE")))
(if (/= qx2 nil)
(progn
(setq en2 (car qx2))
(setq qsd2 (cadr qx2))
(setq zzd1 (getpoint "\n选择第一根线(终止点)[右键结束]:"))
(if (= zzd1 nil)
(progn
(redraw en1 4)
(redraw en2 4)
(redraw en1 1)
(redraw en2 1)
(get-line-list en1)
(setq l1close Dges-plnclose)
(setq p1z line-elev)
(setq Lt1 line-list)
(get-line-list en2)
(setq l2close Dges-plnclose)
(setq p2z line-elev)
(setq Lt2 line-list)
(if (or (= l1close 1) (= l2close 1))
(progn
(setq pt1 (nth 0 lt1))
(p-lt-min pt1 lt2)
(setq pt2 (nth 0 lt2))
(Dges-resort lt2 ptm ptm pt2);sortlt
 (setq lt2 sortlt)
(Dges-lt-area lt1)
(setq area1 area)
(Dges-lt-area lt2)
(if (< (* area1 area) 0)
(setq lt1 (reverse lt1)))
));end if closed
);else 选起止点
(progn
(redraw en2 1)
(setq zzd2 (getpoint "\n选择第二根线(终止点):"))
(redraw en1 4)
(redraw en2 1)
(get-line-list en1)
(setq p1z line-elev)
(setq l1close Dges-plnclose)
(setq Lt1 line-list)
(get-line-list en2)
(setq p2z line-elev)
(setq lt2 line-list)
(setq l2close Dges-plnclose)
(setq pt3 nil)
(if (= l1close 1)
(progn
(setq pt3 (getpoint "\n选择内插区间:"))
(Dges-resort lt1 qsd1 zzd1 pt3)
(setq lt1 sortlt));no close
(progn
 (Dges-resort lt1 qsd1 zzd1 pt3)
 (setq lt1 sortlt)
));end if l1close
(get-line-list en2)
(setq l2close Dges-plnclose)
(setq p2z line-elev)
(setq Lt2 line-list)
(if (= l2close 1)
(progn
(if (= pt3 nil)	(setq pt3 (getpoint "\n选择内插区间:")))
(Dges-resort lt2 qsd2 zzd2 pt3)
(setq lt2 sortlt)
);no close
(progn
(Dges-resort lt2 qsd2 zzd2 pt3)
(setq lt2 sortlt)
)) ;end if l2close
));;;;;end 选择 if
(setq isedpln_qxnc 1)
(setq dz (- p1z p2z))
(setq dgj (/ dz (+ 1 rcQxgs)))
(if (not (equal (abs dgj) Dges-dgj 0.001))
(progn
(initget 128 "Yes No") 
(princ "\n")
(if (eq rcKey nil) 
(setq rckey "yes"))
(cond
((eq rcKey "Yes") (setq isedpln_qxnc 1))
((eq rcKey "No") (setq isedpln_qxnc 0))))))))))
(defun Ed_QxIns(lt1 lt2 p1z p2z / len1 dlt dpt len1 len2 lt1 lt2 ltmp tmpz n1 n2 l1pt l2pt dis1 dis2
				 nmin mm addpt addn)
(if (and (/= lt1 nil) (/= lt2 nil))
(progn
(setq dlt nil)
(setq len1 (length Lt1))
(setq len2 (length Lt2))
(if (< len1 len2);<
(progn
(setq Ltmp Lt1)
(setq Lt1 Lt2)
(setq Lt2 Ltmp)
(setq Lent Len1)
(setq Len1 Len2)
(setq Len2 Lent)
(setq tmpz p1z)
(setq p1z p2z)
(setq p2z tmpz)))
(setq n1 0)
(setq n2 0)
(setq L1pt (nth n1 Lt1))
(setq L2pt (nth n2 Lt2))
(setq dis1 (distance l1pt l2pt))
(setq L2pt (nth (- Len2 1) Lt2))
(setq dis2 (distance l1pt l2pt))
(if (> dis1 dis2)
(setq lt2 (reverse lt2)))
(setq L1pt (car Lt1))
(setq L2pt (car Lt2))
(setq dpt (list l1pt l2pt))
(setq dlt (cons dpt dlt))
(setq nmin 0)
(setq tmpn nmin)
(setq Len21 (- Len2 1))
(while (< n1 Len1) 
(setq L1pt (nth n1 Lt1))
(setq mm n2)
(setq L2pt0 (nth n2 Lt2))
(setq dis1 (distance l1pt l2pt0))
(setq dis1tmp dis1)
(while (< mm Len21)
(setq mm (+ 1 mm))
(setq L2pt1 (nth mm Lt2))
(setq dis2 (distance l1pt l2pt1))
(if (> dis1 dis2)
(progn
(setq nmin mm)
(setq dis1 dis2))));;;while
(if (/= dis1tmp dis1)
(setq n2 (+ 1 n2)))
(setq L2pt (nth nmin Lt2))
(if (> nmin (+ rccs tmpn))
(progn
(setq addn (+ tmpn drccs0))
(while (< addn (- nmin drccs1))
(setq addpt (nth addn Lt2))
(setq dpt (list l1pt addpt))
(setq dlt (cons dpt dlt))
(setq addn (+ 1 addn)))))
(setq dpt (list l1pt l2pt))
(setq dlt (cons dpt dlt))
(setq n1 (+ 1 n1))
(setq tmpn nmin));while
(setq L1pt (last Lt1))
(setq L2pt (last Lt2))
(setq dpt (list l1pt l2pt))
(setq dlt (cons dpt dlt))
(Draw_pln_n dlt))))
(defun Ed_Nc_Lj(qxncent / woff i len ent delent ed zz0 zzz edzzz entiii plzb strpt endpt strx stry pt1 pt2 ss iii nnn)
(if (= NC_BJ_LJ 1)
(progn
(setq qxncaddent qxncent)
(setq delqxncent qxncent)
(setq woff (* ED_SCALE 1.5))
(if (/= qxncaddent nil)
(progn
(setq i 0)
(setq len (length qxncaddent))
(while (< i len)
(setq ent (nth i qxncaddent))
(setq delent ent)
(setq ed (entget ent))
(if (/= ed nil)
(progn
(setq zz0 (nth 3 (assoc 10 ed)))
(if (= zz0 0.0)
(progn
(setq edzzz (entget (entnext ent)))
(setq zz0 (nth 3 (assoc 10 edzzz)))))
(setq zz0 (rtos zz0 2 1))
(setq plzb (get-line-list ent))
(setq strpt (car plzb))
(setq endpt (last plzb))
(IF (and (/= plzb nil) (/= strpt nil) (/= endpt nil))
(progn
(setq strx (nth 0 strpt))
(setq stry (nth 1 strpt))
(setq pt1 (list (- strx woff) (- stry woff)))
(setq pt2 (list (+ strx woff) (+ stry woff)))
(setq ss (ssget "c" pt1 pt2))
(if (/= ss nil)
(progn
(setq iii 0)
(SETQ nnn (sslength ss))
(while (< iii nnn) 
(SETQ entiii (ssname ss iii))
(if (/= ent entiii)
(progn
(setq ed (entget entiii))
(if (/= ed nil)
(progn
(setq ed38 (assoc 38 ed))
(if (= ed38 nil)
(setq zzz (nth 3 (assoc 10 ed)))
(setq zzz (cdr ed38)))
(if (= zzz 0.0)
(progn
(setq edzzz (entget (entnext entiii)))
(setq zzz (nth 3 (assoc 10 edzzz)))))
(if (/= zzz nil)
(setq ZZz (rtos zzz 2 1 ))
(setq ZZz 0))
(if (= zzz zz0)
(progn
(command "ERASE" delent "")
(setq delent (nth i delqxncent))
(command "ERASE" delent "")
(setq lt (get-line-list entiii))
(edplnaddbiao lt plzb strpt endpt (atof zzz))
(Draw_Pln_lt lt)
(entdel entiii)))))))
(setq iii (+ 1 iii)))))))))
(setq endpt nil strpt nil)
(setq i (+ 1 i))))))))
(defun Ed_QxNc(lt1 lt2 p1z p2z / qx1 en1 qsd1 zzd1 qx2 en2 qsd2 zzd2 p1z lt1 p2z lt2 len1 len2 duand1 duand2 i j sti stj pi2 diand
	    pt1i pt1j ptsi ptsj jiaod11 jiaod12 jiaod21 jiaod22 jiaod1 jiaod2 listpp)
(if (and (/= lt1 nil) (/= lt2 nil))
(progn
(setq len1 (- (length Lt1) 1))
(setq len2 (- (length Lt2) 1))
(setq duand1 (distance (nth 0 lt1) (nth 0 lt2)))
(setq duand2 (distance (nth 0 lt1) (nth len2 lt2)))
(if (> duand1 duand2)
    (setq lt2 (reverse lt2)))
(setq i 0)
(setq j 0)
(setq sti i stj j)
(setq pi2 (* pi 2))
(setq diand (list (list (nth 0 lt1) (nth 0 lt2))))
(while (and (< i len1) (< j len2))
    (setq pt1i (nth (+ 1 i) lt1))
    (setq pt1j (nth (+ 1 j) lt2))	
    (setq ptsi (nth sti lt1))
    (setq ptsj (nth stj lt2))
    (setq jiaod11 (angle pt1i ptsi))
    (setq jiaod12 (angle pt1i ptsj))
    (setq jiaod21 (angle pt1j ptsi))
    (setq jiaod22 (angle pt1j ptsj))
    (setq jiaod1 (abs (- jiaod11 jiaod12)))
    (setq jiaod2 (abs (- jiaod21 jiaod22)))
    (if (> jiaod1 pi) (setq jiaod1 (- pi2 jiaod1)))
    (if (> jiaod2 pi) (setq jiaod2 (- pi2 jiaod2)))
    (if (> jiaod1 jiaod2)
    (progn
        (setq i (+ 1 i))
	    (setq listpp (list (nth i lt1) (nth j lt2)))
            (setq diand (cons listpp diand))
	    (setq sti i))
    (progn
        (setq j (+ 1 j))
            (setq listpp (list (nth i lt1) (nth j lt2)))
            (setq diand (cons listpp diand))
	    (setq stj j))))
(if (and (< (- len1 i) 4) (< (- len2 j) 4))
(progn
(setq listpp (list (last lt1) (last lt2)))
(setq diand (cons listpp diand))))
(Draw_pln_n diand))))
(defun Dges-resort(lt pt111 pt222 pt3 / n xyz ltzj 
	     fdpt1 fdpt2 fdpt3 fdpt1n fdpt2n tmplt1 tmplt2)
	(setq sortlt nil tmplt1 nil tmplt2 nil)
	(if (= pt111 nil)
	(setq pt1 (car lt))
	(setq pt1 pt111))
	(if (= pt222 nil)
	(setq pt2 (last lt))
	(setq pt2 pt222))
	(setq ltzj 1)
	(setq n (length lt))
	(setq xyz (nth 0 lt))
	(if (/= xyz (nth (- n 1) lt))
	(progn
	(setq lt (reverse  lt))
	(setq lt (cons xyz lt))
        (setq lt (reverse  lt))
	(setq n (+ 1 n))
	 ));;if /=xyz
	 (p-lt-min pt1 lt)
	 (setq pt1 ptm)
	 (p-lt-min pt2 lt)
	 (setq pt2 ptm)
	 (if (/= pt3 nil)
	  (progn
	 (p-lt-min pt3 lt)
	 (setq pt3 ptm)))
	 (setq i 0 fdpt1 0 fdpt2 0 fdpt3 0)
         (while (< i n)
	 (progn
	 (setq xyz (nth i lt))
	 (if (equal xyz pt1 0.001)
	 (progn
	 (setq fdpt1 1)
	 (setq fdpt1n i)));if
	 (if (equal xyz pt2 0.001)
	 (progn
	 (setq fdpt2 1)
	  (setq fdpt2n i)));if
	(if (/= pt3 nil)
         (progn
       	 (if (equal xyz pt3 0.001)
	 (progn
	 (setq fdpt3 1)
	 (if (or (and (= fdpt1 1) (= fdpt2 1)) (and (= fdpt1 0) (= fdpt2 0)))
	 (progn
	 (setq ltzj 0)	
	 ));if (or
	 ));;(if (= xyz pt3)	 
	 ));; (/= pt3 nil)
	 (if (and (= fdpt1 1) (= fdpt2 1)(= pt3 nil))
	 (progn
	  (setq ltzj 1)
	  (setq i n)
	 ))
	 (setq i (+ 1 i))
	 ));end while
	 (if (> fdpt1n fdpt2n)
	  (setq tmp fdpt1n  fdpt1n fdpt2n  fdpt2n tmp)
	   )
    (if (= ltzj 1)
	 (progn
	  (setq i fdpt1n)
	  (while (<= i fdpt2n)
	  (progn
	  (setq xyz (nth i lt))
	  (setq sortlt (cons xyz sortlt))
	  (setq i (+ 1 i))
	  ))
	  (setq sortlt (reverse sortlt))
          );else /= 1
	 (progn
	 (setq i 0)
	  (while (<= i fdpt1n)
	  (progn
	  (setq xyz (nth i lt))
	  (setq tmplt1 (cons xyz tmplt1))
	  (setq i (+ 1 i))
	  ))
	  (setq tmplt1 (reverse tmplt1))
          (setq i fdpt2n)
	  (while (< i n)
	  (progn
	  (setq xyz (nth i lt))
	  (setq tmplt2 (cons xyz tmplt2))
	  (setq i (+ 1 i))
	  ))
	  (setq tmplt2 (reverse tmplt2))
	(append tmplt1 tmplt2)		
	  (setq ptz (last xyz))
	  (setq sortlt and-lt)
     ));end if
(setq sortlt sortlt)
)
(defun p-lt-min(pt lt / i pti mins n dis)
 (setq mins 9999.0)
 (if (and (/= lt nil) (/= pt nil))
 (progn
 (setq n (length lt))
 (setq i 0)
 (repeat n
 (setq pti (nth i lt))
 (if (/= pti nil)
 (progn
 (setq dis (distance pt pti))
 (if (< dis mins)
  (progn
 (setq mins dis)
 (setq ptm pti)
 ))
 ));if pti
 (setq i (+ 1 i))
  );repeat
 ));if and
)
(defun Draw_pln_n(diand / ddlen di ddb 
	    tmpp11 tmpp12 tmpp21 tmpp22 ang1 ang2 ang3 ang4 pnt1 pnt2 pnt3 pnt4 pnt5 m gs n pt1 pt2 pptx
            ppty pptz ppt ang12 ang13 ang2a )
(setq qxncaddent nil)
;;;;;;;;;  优化
(setq ddlen (length diand))
(setq di 0)
(SETQ ddb (list (nth 0 diand)))
(while (< di (- ddlen 2))
(progn
   (setq tmpp11 (nth 0 (nth di diand)))
   (setq tmpp12 (nth 1 (nth di diand)))
   (setq tmpp21 (nth 0 (nth (+ 2 di) diand)))
   (setq tmpp22 (nth 1 (nth (+ 2 di) diand)))
   (if (or (equal tmpp11 tmpp21) (equal tmpp12 tmpp22))
   (progn
      (setq ddb (cons (nth (+ 1 di) diand) ddb))
      (setq di (+ 1 di))
    )
   (progn
      (setq ddb (cons (nth (+ 2 di) diand) ddb))
      (setq di (+ 2 di))
   ))
))
(if (= di (- ddlen 2))
  (setq ddb (cons (nth (- ddlen 1) diand) ddb))
)
(setq diand ddb ddb nil)
;;;;;画线
(command "layer" "m" sqxlayer "" "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yjy去波init bg
(setq ang1 nil ang2 nil ang3 nil ang4 nil
      pnt1 nil pnt2 nil pnt3 nil pnt4 nil pnt5 nil
)	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yjyed
(setq m (length diand))
(setq gs 0)
(while (< gs RCQxgs)
  (setq n 0)
  (setq plzb nil)
  (if (= Is_3Dpln 1)
(command "3dpoly")
(command "pline")
)
     (setq pptz (+ (* (/ (- p2z p1z) (+ 1 RCQxgs)) (+ 1 gs)) p1z))
  (while (< n m)
     (setq diandd (nth n diand))
     (setq pt1 (nth 0 diandd))
     (setq pt2 (nth 1 diandd))
     (setq pptx (+ (* (/ (- (nth 0 pt2) (nth 0 pt1)) (+ 1 RCQxgs)) (+ 1 gs)) (nth 0 pt1)))
     (setq ppty (+ (* (/ (- (nth 1 pt2) (nth 1 pt1)) (+ 1 RCQxgs)) (+ 1 gs)) (nth 1 pt1)))
     (setq ppt (list pptx ppty pptz))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yjy去波bg
     (if (/= pnt4 nil)
     (setq pnt5 pnt4)
     )
     (if (/= pnt3 nil)
     (setq pnt4 pnt3)
     )
     (if (/= pnt2 nil)
     (setq pnt3 pnt2)
     )
     (if (/= pnt1 nil)
     (setq pnt2 pnt1)
     )
     (setq pnt1 ppt)
     (if (and (/= pnt1 nil) (/= pnt2 nil) (/= pnt3 nil) (/= pnt4 nil) (/= pnt5 nil))
     (progn
	(setq ang1 (ang3pnt pnt5 pnt4 pnt3))
	(setq ang2 (ang3pnt pnt4 pnt3 pnt2))
	(setq ang3 (ang3pnt pnt3 pnt2 pnt1))
	(setq ang12 (* ang1 ang2))
	(setq ang13 (* ang1 ang3))
	(setq ang2A (abs ang2))
	(if (not (or (and (> ang13 0) (< ang12 0) (> ang2A qbo_ang1)) (> ang2A qbo_ang2))) 
        (if (> n 8)
	(command pnt3)	
	(command ppt)	
	)
	)
     )
	(progn
	(command ppt)	
     ))	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yjyed
     (setq n (+ 1 n))
  )
;;;;;;;;;;;;;;;
(command pnt2)
(command pnt1)
;;;;;;;;;;;;;;;
  (command "")	
  (setq entL (entlast))
  (setq qxncaddent (cons entL qxncaddent))
(setq gs (+ 1 gs))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yjy
(defun ang3pnt(pt0 pt1 pt2 / ang10 ang12 angzy zzjj)
(setq ang10 (rtod (angle pt1 pt0)))
(setq ang12 (rtod (angle pt1 pt2)))
(setq ang (- ang10 ang12))
(setq angabs (abs ang))
(setq angJ (- angabs 180.0))
(if (< angabs 180.0)
(progn
(if (< ang 0.0)
(setq angJ (abs angJ))
(setq angJ (- 0.0 (abs angJ)))
)
))
(if (> angabs 180.0)
(progn
(if (< ang 0.0)
(setq angJ (- 0.0 (abs angJ)))
(setq angJ (abs angJ))
)
))
;;;;;;
;(setvar "luprec" 0)
;(setq zzjj (rtos angJ))
;(command "text" pt1 "1" "" zzjj)
(setq Myang angJ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun rtod(r)
(/ (* r 180.0) 3.1415926)
)
;;;;;;;;;;;;;;;;;;;;;;;;

(print)
  (princ "  (^_^)GB-512(^_^)  OK！")
(GB512blc)