[下载]：一个综合lisp程序大集合ZCR.lsp

duely

这是我一个朋友自编的综合lisp程序大集合ZCR.lsp
(setq ll (getvar "CDATE"))
(setq ll1 (fix ll))

(setq ll2 (itoa ll1))
(SETQ DA_y (SUBSTR LL2 1 4))
(SETQ DA_m (SUBSTR LL2 5 2))
(SETQ DA_D (SUBSTR LL2 7 2))

(prompt "\n\n     ********")
               (princ "    Today is ")
               (princ da_y)
                (princ " . ")
               (princ da_m)
               (princ " . ")
               (princ da_d)
(princ "     *******")
(princ "\n\n                 Welcome to use this progrem")
(prompt"\n\n                 Please type ZCR for Help......                   \n")
(graphscr)




(defun c:ZCR()
(textscr)
(prompt "                                                              \n")
(prompt "                                                              \n")
(prompt "                AUTOCAD----简化命令表                         \n")
(prompt "                                                              \n")
(prompt "                                                              \n")
(prompt "         bm----break 'mid'             be---break 'end'       \n")
(prompt "         bi----打破break 'int'         bn---break 'nea'       \n")
(prompt "         bzyx--标注座标点              bza,bzb--标注标高      \n")                  
(prompt "                                       bzax,bzbx              \n")
(prompt "         pz---设置扑作框为4            \n")
(prompt "         dm1--设置标注尺寸环境         \n")
(prompt "         dm---自动标注尺寸        ff----倒圆角(包括粗线圆角)  \n")
(prompt "         gx---改线宽                   gzg--改字高            \n")
(prompt "         gs---改数                     gys----改颜色          \n")
(prompt "         gz---字替换                   gzx--改字形             \n")
(prompt "         gzk--改字宽                   \n")
(prompt "         gbg--改属性标高               jd----测量两直线夹角   \n")
(prompt "         hx---座标数据文件(dat)划线    hxx---相对座标数据文件(datx)划线 \n")

(setq wwwww (getstring "\n请按回车键继续                               \n"))
(if (= wwwww "")(progn
(textscr)      
(prompt "         ofc--offset(change color)    \n")
(prompt "         ofl--offset(change layer,color)    \n")
(prompt "         oi---osnap 'int'              on---osnap 'nea'       \n")
(prompt "         om--osnap 'mid'               off--osnap 'off'       \n")
(prompt "         rr---正方形                   r1--给出两条边的长方形 \n")
(prompt "         r2---给出两对角点的长方形    \n")
(prompt "         rtk--旋转图框                \n")
(prompt "                                      \n")

(prompt "         xj-----设置两线相交(包括粗线)                        \n")
(prompt "         xc---实体选择,(XC)            \n")
(prompt "         TOUT-将图形文字写入文件       TIN---插入汉字         \n")
(prompt "         D90---镜像尺寸线旋转90度                \n")
(prompt "         ZZT---轴测图                  ZZTHY---轴测图还原      \n")
(prompt "         gxx m1 ll m3 dmm 3dkc hb fk chx 3dcp lll 3dl km kc    \n")

(prompt"\n\n               --中国市政工程中南设计院-- \n")
(prompt"                          郭帮毅\n")

))
  (prin1)

)


(defun tou()
      (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
)
(defun wei()
        (setvar "cmdecho" joj)
(setvar "osmode" ojo)
)


(defun c:rtk(/ p1 p2 yn aa ss a b)
(tou)
(command "osnap" "end")
(princ "\n图框旋转 ----GuoBangYi 1994.10 shenzhen.")
(setq p1 (getpoint "\n请点取图框左下角点<基点>(first point):? "))
(setq p2 (getpoint "\n请点取图框右下角点(secand point):? "))
(command "osnap" "off")
(setq yn (getstring "\n要选择实体吗(do you want select object)<N>:? "))
(setq aa (angle p1 p2))
(setq aa (- 0 (* aa (/ 180 pi))))
            (if (or (/= yn "Y") (/= yn "y"))(progn
             (setq a (getvar "vsmin"))
          (setq b (getvar "vsmax"))
          (setq ss (ssget "C" a b ))
            ))
(if (or (= yn "y") (= yn "Y"))
(setq ss (ssget))
                           )
(command "rotate" ss "" p1 aa)
(command "zoom" "e")
(wei)
)


(DEFUN C:CENG()
  (COMMAND "LAYER" "M" "CHU" "M" "WALL" "M" "CHUK" "M" "XIAN" "M" "RXD" "M" "ZHU""")

(COMMAND "LAYER" "M" "CHIBI" "M" "ZDB" "M" "SHUI" "" )
)



(defun c:ms()
          (command "mslide" pause))
(defun c:vs()
          (command "vslide" pause))

(defun c:zxhx(/ zh)
   ;(setq xh (getstring "\n轴线名:?    "))
   (setq zh (getstring "\n轴号:?    "))
   (command "insert" "zxhx" pause "1" "1" "" zh)
    )
(defun c:zxhy(/ zh)
   ;(setq xh (getstring "\n轴线名:?    "))
   (setq zh (getstring "\n轴号:?    "))
   (command "insert" "zxhy" pause "1" "1" "" zh)
    )
(defun c:zxhs(/ zh)
   ;(setq xh (getstring "\n轴线名:?    "))
   (setq zh (getstring "\n轴号:?    "))
   (command "insert" "zxhs" pause "1" "1" "" zh)
    )
(defun c:zxhz(/ zh)
   ;(setq xh (getstring "\n轴线名:?    "))
   (setq zh (getstring "\n轴号:?    "))
   (command "insert" "zxhz" pause "1" "1" "" zh)
    )



(defun c:zzt()
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

   (command "vpoint" "1,-1,1")
   (setvar "cmdecho" joj)
(setvar "osmode" ojo)
   (prin1)
   )
(defun c:zzthy()
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

   (command "vpoint" "0,0,1")
   (setvar "cmdecho" joj)
(setvar "osmode" ojo)
   (prin1)
   )
(defun aaa (s)
   (if (/= s "Function cancelled")   ; If an error (such as CTRL-C) occurs
      (princ (strcat "\nError: " s)) ; while this command is active.
   )
   (setq p nil)                      ; Free selection set
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

(defun C:GZ(/ p l n e os as ns st s nsl osl sl si chf chm olderr)
(prompt "新文字替换旧文字--\n")

   (setq olderr  *error*             ; Initialize variables
         *error* aaa)
(setq chm 0)
(setq p (ssget))                  ; Select objects
   (if p (progn                      ; If any objects selected
      (while (= 0 (setq osl (strlen (setq os (getstring t
                               "\n要替换的旧字符--old string? ")))))
            (princ "Null input invalid")
      )
      (setq nsl (strlen (setq ns (getstring t "\n要替换的新字符--new string? "))))
      (setq l 0 n (sslength p))
      (while (< l n)                 ; For each selected object...
         (if (= "TEXT"               ; Look for TEXT entity type (group 0)
                (cdr (assoc 0 (setq e (entget (ssname p l))))))
            (progn
               (setq chf nil si 1)
               (setq s (cdr (setq as (assoc 1 e))))
               (while (= osl (setq sl (strlen
                             (setq st (substr s si osl)))))
                  (if (= st os)
                      (progn
                        (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                        (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
         (setq l (1+ l))
      )
   ))
   (princ "Changed ")                ; Print total lines changed
   (princ chm)
   (princ " text lines.")
   (terpri)
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)


(defun C:TM(/ p l n e os as ns st s nsl osl sl si chf chm olderr);'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
(prompt "新文字替换旧文字--\n")

   (setq olderr  *error*             ; Initialize variables
         *error* aaa)
(setq chm 0)
(setq p (ssget))                  ; Select objects
   (if p (progn                      ; If any objects selected
      (while (= 0 (setq osl (strlen (setq os "施工图" ))))
            (princ "Null input invalid")
      )
      (setq nsl (strlen (setq ns "初步设计" )))
      (setq l 0 n (sslength p))
      (while (< l n)                 ; For each selected object...
         (if (= "TEXT"               ; Look for TEXT entity type (group 0)
                (cdr (assoc 0 (setq e (entget (ssname p l))))))
            (progn
               (setq chf nil si 1)
               (setq s (cdr (setq as (assoc 1 e))))
               (while (= osl (setq sl (strlen
                             (setq st (substr s si osl)))))
                  (if (= st os)
                      (progn
                        (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                        (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
         (setq l (1+ l))
      )
   ))
   (princ "Changed ")                ; Print total lines changed
   (princ chm)
   (princ " text lines.")
   (terpri)
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

(defun C:TM1(/ p l n e os as ns st s nsl osl sl si chf chm olderr);'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
(prompt "新文字替换旧文字--\n")

   (setq olderr  *error*             ; Initialize variables
         *error* aaa)
(setq chm 0)
(setq p (ssget))                  ; Select objects
   (if p (progn                      ; If any objects selected
      (while (= 0 (setq osl (strlen (setq os "施" ))))
            (princ "Null input invalid")
      )
      (setq nsl (strlen (setq ns "初" )))
      (setq l 0 n (sslength p))
      (while (< l n)                 ; For each selected object...
         (if (= "TEXT"               ; Look for TEXT entity type (group 0)
                (cdr (assoc 0 (setq e (entget (ssname p l))))))
            (progn
               (setq chf nil si 1)
               (setq s (cdr (setq as (assoc 1 e))))
               (while (= osl (setq sl (strlen
                             (setq st (substr s si osl)))))
                  (if (= st os)
                      (progn
                        (setq s (strcat (substr s 1 (1- si)) ns
                                        (substr s (+ si osl))))
                        (setq chf t) ; Found old string
                        (setq si (+ si nsl))
                      )
                      (setq si (1+ si))
                  )
               )
               (if chf (progn        ; Substitute new string for old
                  (setq e (subst (cons 1 s) as e))
                  (entmod e)         ; Modify the TEXT entity
                  (setq chm (1+ chm))
               ))
            )
         )
         (setq l (1+ l))
      )
   ))
   (princ "Changed ")                ; Print total lines changed
   (princ chm)
   (princ " text lines.")
   (terpri)
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

(defun c:xj( / p1 p2 a b cc g cd cd1 c d )
(prompt "两线相交于一端点\n")
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)

          (setq p1 (getpoint "请选择第一条线 --first line:?\n"))
          (setq p2 (getpoint "请选择第二条线 --second line:?\n"))
          (setq a (ssget p1))
          (setq b (ssget p2))
          (setq cc 0)
          (setq g (ssname a cc))
          (setq c (entget g))
      (setq cd (cdr (assoc 0 c)))
      (if (or (= cd "POLYLINE") (= cd "LWPOLYLINE"))(PROGN
          (setq d (cdr (assoc 40 c)))

     (command "explode" p1)))


               (setq g (ssname b cc))
          (setq c (entget g))
      (setq cd1 (cdr (assoc 0 c)))
      (if (or (= cd1 "POLYLINE")(= cd1 "LWPOLYLINE"))(PROGN
          (setq d1 (cdr (assoc 40 c)))

     (command "explode" p2)))


     (command "chamfer" "d" 0 0 "")
     (command "chamfer" p1 p2 "")
  (if (or (= cd "POLYLINE")(= cd "LWPOLYLINE"))
     (command "pedit" p1 "y" "w" d ""))
    (if (or (= cd1 "POLYLINE")(= cd1 "LWPOLYLINE"))
     (command "pedit" p2 "y" "w" d1 ""))
     (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(print)

  )



(defun c:ol(/ ss1 ssa ee ent)
    (tou)
(setvar "cmdecho" 0)
            (setq ss1 (entsel "\nselect layer_line:? "))
          (setq ssa (car ss1))
          (setq ee (entget ssa))
          (setq ent (cdr (assoc 8 ee)))

(command "layer" "off" ent "")
(wei)
(princ)

)



(setq jh 240)
(DEFUN C:MM( /  s da a db pa p1 p2 ang  JJ ss as)
(tou)   
     (command "osnap" "off")
            (setq olderr *error* *error* aaa)
            (setvar "cmdecho" 1)
      (setq s (ssget))   
        (SETQ P1 (GETPOINT "基点 base point-->: "))

   (SETQ P2 (GETPOINT P1 "\n 方向 second point-->: "))

   (princ "距离--DIST--<")
            (princ jh)
            (setq da (getreal ">: "))
                  (if (/= da nil)(setq jh da))
   
        (SETQ ANG (ANGLE P1 P2))
        (IF (= ANG (/ PI 2))(SETQ AS "<90"))
                       (progn((setq jj (rtos jh 2 3))
                                  (SETQ SS (strcat "@" jj AS))
           
                           (COMMAND "MOVE" s "" p1 ss )
                         )   
                   )
      (IF (= ANG 0)(SETQ AS "<0"))
                         (progn((setq jj (rtos jh 2 3))
                                  (SETQ SS (strcat "@" jj AS))
           
                           (COMMAND "MOVE" s "" p1 ss )
                         )   
                )   

       (IF (= ANG  PI)(SETQ AS "<180"))
                                 (progn((setq jj (rtos jh 2 3))
                                  (SETQ SS (strcat "@" jj AS))
           
                           (COMMAND "MOVE" s "" p1 ss )
                         )   
             )
            (IF (= ANG (* 3 (/ PI 2)))(SETQ AS "<270"))
                        (progn((setq jj (rtos jh 2 3))
                                  (SETQ SS (strcat "@" jj AS))
           
                           (COMMAND "MOVE" s "" p1 ss )
                         )   
             )
  


          (setvar "cmdecho" 1)
(wei)
(print)
)

(DEFUN C:cpp( /  s da a db pa p1 p2 ang  JJ ss as)
(tou)   
     (command "osnap" "off")
            (setq olderr *error* *error* aaa)
            (setvar "cmdecho" 0)
      (setq s (ssget))   
        (SETQ P1 (GETPOINT "基点 base point-->: "))

   (SETQ P2 (GETPOINT P1 "\n 方向 second point-->: "))

   (princ "距离--DIST--<")
            (princ jh)
            (setq da (getreal ">: "))
                  (if (/= da nil)(setq jh da))
            
     
        (SETQ ANG (ANGLE P1 P2))
        (IF (= ANG (/ PI 2))(SETQ AS "<90"))
      (IF (= ANG 0)(SETQ AS "<0"))
       (IF (= ANG  PI)(SETQ AS "<180"))
      (IF (= ANG (* 3 (/ PI 2)))(SETQ AS "<270"))
      
  (setq jj (rtos jh 2 3))

           (SETQ SS (strcat "@" jj AS))
        
            (COMMAND "copy" s "" p1 ss )
         
          (setvar "cmdecho" 1)
(wei)
(print)
)


(DEFUN C:ss( /  s da a db pa p1 p2 ang  JJ ss as)
(tou)   
     ;(command "osnap" "off")
            (setq olderr *error* *error* aaa)
            (setvar "cmdecho" 0)
     
   
(SETQ Pa (GETPOINT "基点 base point-->: "))

  (SETQ P3 (GETcorner pa "to point-->: "))

  (SETQ P1 (GETPOINT "基点 base point-->: "))
(SETQ P2 (GETPOINT P1 "\n 方向 second point-->: "))

   (princ "距离--DIST--<")
            (princ jh)
            (setq da (getreal ">: "))
                  (if (/= da nil)(setq jh da))
            
     
        (SETQ ANG (ANGLE P1 P2))
        (IF (= ANG (/ PI 2))(SETQ AS "<90"))
      (IF (= ANG 0)(SETQ AS "<0"))
       (IF (= ANG  PI)(SETQ AS "<180"))
      (IF (= ANG (* 3 (/ PI 2)))(SETQ AS "<270"))
      
  (setq jj (rtos jh 2 3))

           (SETQ SS (strcat "@" jj AS))
        
      (COMMAND "stretch" "c" pa p3 "" p1 ss )   
     
         
          (setvar "cmdecho" 1)
(wei)
(print)
)



(defun c:tjs();(/ b ss tt c e v xx ls ts)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)


(setq olderr  *error*             ; Initialize variables
         *error* aaa)
        (setq ss (ssget))
(setq ts 0)
(setq tt (sslength ss))
(setq c 0)
(setq b 0)
(repeat tt
     (setq e (ssname ss c))
        (setq v (entget e))
        (setq xx (cdr (assoc 0 v)))

        (if (or (= xx "TEXT") (= xx "MTEXT"))
                (progn(setq ls (cdr (assoc 1 v)))
                               (PRINC ls)
                                      (setq ls (atof ls))
                        (setq ts (+ ts ls))
                                      (setq b (1+ b))
                  )
         )
     (setq c (1+ c))

)

(princ "the number is ")
(princ b)
(princ "\n----------The total is  ")
(princ ts)
(princ "   ------------")
(WEI)
)



(defun c:CHL(/ ss1 ssa ee ent cor ent1)
   
(tou)
     (setvar "cmdecho" 0)  
    (setq ss1 (entsel "\nselect layer_line:? "))
          (setq ssa (car ss1))
          (setq ee (entget ssa))
          (setq ent1 (cdr (assoc 0 ee)))
                  (setq ent (cdr (assoc 8 ee)))
                 (setq cor (cdr (assoc 62 ee)))
(command "layer" "S" ent "")
(if (/= cor nil)(command "color" cor)(command "color" "bylayer"))
(princ "\n     -------The layer is ")
(princ ent)
(princ "!!  the color is ")
(if (/= cor nil)(princ cor)(princ "BYLAYER"))
(princ " !!------    *OK*\n")
(if (= ent1 "BLOCK")(princ "\n ------The layer_line is !!!!!!!!!!!!!BLOCK!!!!!!!!!!!------"))
(wei)
(princ)
)


(defun c:cha(/ dl1 dl2 p1 p2 a b cc cd cd1 g c d )
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
         (setq dla 0)
         (princ"\nfirst dist<")
         (princ dla)
         (setq dl1 (getdist ">:? "))
         (if (/= dl1 nil)(setq dla dl1))
         (setq dlb dla)
         (princ"\nsecond dist<")
         (princ dla)
         (setq dl2 (getdist ">:? "))
         (if (/= dl2 nil)(setq dlb dl2))
          (setq p1 (getpoint "\n请选择第一条线 --first line:?"))
          (setq p2 (getpoint "\n请选择第二条线 --second line:?"))
          (setq a (ssget p1))
          (setq b (ssget p2))

          (setq cc 0)
          (setq g (ssname a cc))
          (setq c (entget g))
      (setq cd (cdr (assoc 0 c)))
      (if (or (= cd "LWPOLYLINE")(= cd "POLYLINE"))(PROGN
          (setq d (cdr (assoc 40 c)))

     (command "explode" p1)))


               (setq g (ssname b cc))
          (setq c (entget g))
      (setq cd1 (cdr (assoc 0 c)))
      (if (OR (= CD1 "LWPLOYLINE")(= cd1 "POLYLINE"))(PROGN
          (setq d1 (cdr (assoc 40 c)))
     (command "explode" p2)))
              (setq p3 (ssget p1))
              (setq p4 (ssget p2))

     (command "chamfer" "d" dla dlb "")
     (command "chamfer" p1 p2 "")

            (setq u (entlast))
   (IF (OR (= CD "LWPOLYLINE")(= cd "POLYLINE"))(PROGN
       (command "pedit" p3 "y" "w" d "")

       (command "pedit" u "y" "w" d "")
       ))
   (IF (OR (= CD1 "LWPOLYLINE")(= cd1 "POLYLINE"))(PROGN

        (command "pedit" p4 "y" "w" d1 "")
                )
   )

(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(print)

  )




(defun c:ff(/ x p1 p2 ss b u l xx xx1 e ff d p3 p4)
(prompt "\n替换原fillet命令,可同时对粗线和细线倒圆角")

             (setq olderr  *error*             ; Initialize variables
         *error* aaa)
(setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)


              (setq x (getreal "\n圆角半径r:<--R-->?"))
              (setq p1 (getpoint "\n请选择第一条线 --first line:? "))
              (setq p2 (getpoint "\n请选择第二条线 --second line:? "))
              (setq ss (ssget p1))
              (setq b (ssget p2))
              (setq l 0)
              (setq e (ssname ss l))
              (setq ff (entget e))
        (SETQ XX (CDR (ASSOC 0 FF)))
   (IF (or (= XX "POLYLINE") (= XX "LWPOLYLINE"))(PROGN
                     (setq d (cdr (assoc 40 ff)))
                (command "explode" ss)
                                   ))

              (setq e (ssname b l))
              (setq ff (entget e))
        (SETQ XX1 (CDR (ASSOC 0 FF)))
   (IF (or (= XX1 "POLYLINE") (= XX "LWPOLYLINE"))(PROGN
                     (setq d1 (cdr (assoc 40 ff)))
                (command "explode" b)
                                   ))




              (setq p3 (ssget p1))
              (setq p4 (ssget p2))
                 (command "fillet" "r" x)
                 (command "fillet" p1 p2)
              (setq u (entlast))
   (if (= u nil)(command "u" ""))
   (IF (or(= XX "POLYLINE")(= XX "LWPOLYLINE"))(PROGN
       (command "pedit" p3 "y" "w" d "")

       (command "pedit" u "y" "w" d "")))
   (IF (or(= XX "POLYLINE")(= XX "LWPOLYLINE"))(PROGN

        (command "pedit" p4 "y" "w" d1 "")
                )
   )
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)


   )

(defun c:lle()
(command "line" "end"))
(defun c:dm1( / a b c d)

          (setq a (getreal "请输入绘图单位<BL>:(1 or 100)"))
          (setq b (* 2 a))
          (setq c (* 1.2 a))
          (setq d (* 3 a))
            (setvar "dimexe" b)
            (setvar "dimtad" 1)
            (setvar "dimtih" 0)
            (setvar "dimtsz" c)
            (setvar "dimtxt" d)
            (setvar "dimdli" 0)
            (setvar "dimdle" 0)
       (setq txtg (getvar "dimtxt"))
       (princ "   尺寸字高是(height) ")
       (princ txtg)
       (setq txta 0)
       (princ "   \n尺寸线偏移量(DIST OFFSET)<")
       (princ txta)
       (setq txtg1 (getreal ">:?"))
       (if (/= txtg1 nil)(setq txta txtg1))
       (setvar "dimexo" txta)
        )

(defun c:aa( / n a b h pa c x1 x2 x3 x4 pb)
(tou)
            (setq olderr *error* *error* aaa)
            (setq n (getint "\n单向距阵复制个数(包括本身) --how much? "))
            (setq a (getint "\nx方向距离---? "))
            (setq b (getint "\ny方向距离---? "))
            (setq h (ssget))
     ;       (setq pa (getpoint "基点--base point: ?"))
     (setq pa (getvar "extmin"))
      (setq c 1)
    (while (<= c (- n 1))
        (setq x1 (* a c))
        (setq x2 (* b c))
        (setq x3 (itoa x1))
        (setq x4 (itoa x2))
        (setq pb (strcat "@" x3 "," x4))
        (command "copy" h "" pa pb)
              (SETQ C (+ C 1))
     )
(wei)
)


        (setq jh 240 d11 0)

(DEFUN C:DD1( / da a db pa p1 p2 ang ang1 ang2 p3 p4 p5 p6)
(tou)   
(prompt "\n画双线  GUOBANGYI copyright DD--2.0 93.10.17 深圳")
     (command "osnap" "off")
            (setq olderr *error* *error* aaa)
            (setvar "cmdecho" 0)
            (princ "双线间的距离--qiang_hou--<")
            (princ jh)
            (setq da (getreal ">: "))
                  (if (/= da nil)(setq jh da))
            (SETQ A (/ jh 2))
              (princ "线条加粗<")
              (princ d11)
              (setq db (getreal ">: "))
                    (if (/= db nil)(setq d11 db))
          (SETQ Pa (GETPOINT "从点 base point-->: "))
          (command "point" pa)
    (repeat 30
        (setq p1 (getvar "LASTPOINT"))
        (SETQ P2 (GETPOINT P1 "\n 到点 second point-->: "))
        (SETQ ANG (ANGLE P1 P2))
        (SETQ ANG1 (+ ANG (/ PI 2)))
        (SETQ ANG2 (- ANG (/ PI 2)))
        (SETQ P3 (POLAR P1 ANG1 a))
        (SETQ P4 (POLAR P1 ANG2 a))
        (SETQ P5 (POLAR P2 ANG1 a))
        (SETQ P6 (POLAR P2 ANG2 a))
            (COMMAND "PLINE" P3 "W" D11 D11 p5 "")
            (COMMAND "PLINE" P4 "W" D11 D11 P6 "")
            (command "point" p2)
    )
          (setvar "cmdecho" 1)
(wei)
)



(defun c:cls( / x a b)
           (prompt "清除当前视窗吗--clear screen<N>?")
           (setq x (getstring "(Y or N): ?"))
            (if (or (= x "Y")(= x "y"))(progn
             (setq a (getvar "vsmin"))
          (setq b (getvar "vsmax"))
          (command "erase" "c" a b "")
          (redraw)
          ) "")
)
(defun c:l1 ( / a b)
           (setq a (setvar "LASTPOINT" (getpoint "Reference point:(参考点: )")))
           (setq b (getpoint a "\nEnter relative/polar coordinates (with @):\n相对距里 "))
                    (command "line" b )
)
(defun c:ll()
            (setq olderr *error* *error* aaa)
           (setq p1 (getpoint "起始点--base point: "))
           (setq a (getstring "x方向相对距离: "))
           (setq b (getstring "y方向相对距离: "))
            (setq p2 (strcat "@" a "," b))
            (command "line" p1 p2 "")
       (repeat 20
               (setq a (getstring "x方向相对距离: "))
              (setq b (getstring "y方向相对距离: "))
             (setq p2 (strcat "@" a "," b))
           (command "line" "" p2 "")
       )
)




(setq bl 1 )
(defun c:oe()
(command "osnap" "end"))
(defun c:oi()
(command "osnap" "int")
)
(defun c:on()
(command "osnap" "nea"))
(defun c:om()
(command "osnap" "mid"))
(defun c:off()
(PRINC "\n扑捉点关闭\n")
(command "osnap" "off")
)
(defun c:pz()
(setvar "pickbox" 4)
)
(defun c:xs()
(setvar "blipmode" 1)
)
(defun c:xoff()
(setvar "blipmode" 0)
)

(defun c:be()
(TOU)
(setq ss (ssget))
(command "osnap" "end")
  (setq q (getpoint "get point:?\n"))
(command "break" ss q q )
(command "osnap" "off")
(wei)
)
(defun c:bi()
(tou)
(setq ss (ssget))
(command "osnap" "int")
  (setq q (getpoint "get point:?\n"))
(command "break" ss q q )
(command "osnap" "off")
(wei)
)
(defun c:bn()
(tou)
(setq ss (ssget))
(command "osnap" "nea")
  (setq q (getpoint "get point:?\n"))
(command "break" ss q q )
(command "osnap" "off")
(wei)
)
(defun c:bm()
(tou)
(setq ss (ssget))
(command "osnap" "mid")
  (setq q (getpoint "get point:?\n"))
(command "break" ss q q )
(command "osnap" "off")
(wei)
)

     (defun r() (command "r") (xc))
     (defun a() (command "a") (xc))

(defun xc( / olderr t1 t2 t3 t4 s1 f1 f2 ff len c n)
            (setq olderr *error* *error* aaa t1 T f2 'f1)
     (while t1
             (initget "Block Color Entity LAyer LType Style Thickness")
               (setq t1 (getkword
     "\n>>B块名/C颜色/E实体/LA层/LT线型/S字型/T厚度: "))
  (setq t2
     (cond
        ((eq t1 "Block")      2)   ((eq t1 "Color")     62)
        ((eq t1 "Entity")     0)   ((eq t1 "LAyer")      8)
        ((eq t1 "LType")      6)   ((eq t1 "Style")      7)
        ((eq t1 "Thickness") 39)))
  (initget 1)
  (setq t3
     (cond
        ((= t2  2)  (getstring "\n>>块名: "))
        ((= t2 62)  (initget "?")
                    (while
                       (or (eq (setq t3 (getint "\n>>颜色号/<?>: ")) "?")
                           (null t3)
                           (> t3 256)
                           (< t3 1))
                           (textscr)
          (princ "\n                                                     \n")
          (princ "\n           Color number(颜色号) |Standard meaning(含意)")
          (princ "\n                ________________|____________________")
          (princ "\n                                |                    ")
        ; (princ "\n                       0        |      <BYBLOCK>     ")
          (princ "\n                       1        |      Red           ")
          (princ "\n                       2        |      Yellow        ")
          (princ "\n                       3        |      Green         ")
          (princ "\n                       4        |      Cyan          ")
          (princ "\n                       5        |      Blue          ")
          (princ "\n                       6        |      Magenta       ")
          (princ "\n                       7        |      White         ")
          (princ "\n                    8...255     |      -Varies-      ")
          (princ "\n                      256       |      <BYLAYER>     ")
          (princ "\n                                               \n\n\n")
                          (initget "?")) t3)
        ((= t2  0)  (getstring "\n>>E实体类型: "))
        ((= t2  8)  (getstring "\n>>LA层名: "))
        ((= t2  6)  (getstring "\n>>LT线型名: "))
        ((= t2  7)  (getstring "\n>>S字型名: "))
        ((= t2 39)  (getreal   "\n>>Th厚度: "))
        (T          nil)))
          (if t3 (setq t4 t3))
              (if t2 (setq t5 t2))


  (if t3 (setq f1 (cons (cons t2 t3) f1)))
)
(setq f2 (ssget "x" (eval f2)))
(setq ff (ssadd))
(if (and (/= f2 nil)(= t5 62))(progn
       (setq n 0)
      
        (setq len (sslength f2))
       (repeat len
          (setq ss (ssname f2 n))
       (setq ff (ssadd ss ff))
       (setq n (1+ n))
           (princ ff)
           )
       )
   )
(if (= t5 62)(progn
       (setq sl (xcc t4))
       (setq c 0)
       (setq len (sslength sl))
       (repeat len
          (setq s1 (ssname sl c))
       (setq ff (ssadd s1 ff))
       (setq c (1+ c))
           )
       (setq f2 ff)
       )

   )





(setq *error* olderr)
(if (and f1 f2) f2 (progn (princ "\n没有发现.") (prin1)))
)

(defun c:dimh()
(command "dim" "hor"))
(defun c:dimv()
(command "dim" "ver"))
(defun c:dima()
(command "dim" "ali"))



(defun c:lts(/ d bl)
(setq p1 (getpoint "\ndraw_left_down point:?"))
(setq p2 (getpoint p1 "\ndraw_right_up point:?"))
(setq d (distance p1 p2))
(setq bl (/ d 40))
(command "ltscale" bl)
)




(DEFUN C:RR()

(prompt "               ------画正方形-----")
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
;(setvar "osmode" 0)
            (SETQ IP (GETPOINT "\n请输入左下角点(left_down point): ? "))
            (SETQ A (GETDIST "\n边长(length): ?-- "))
            (COMMAND "LINE" IP (LIST (+ A (CAR IP)) (CADR IP))
            (LIST (+ A (CAR IP)) (+ A (CADR IP)))
            (LIST (CAR IP) (+ A (CADR IP)))  "C")
      (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
   (prin1)

         )
(DEFUN C:R1()
(prompt "               ------给出两条边的距形-----")
                     (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
;(setvar "osmode" 0)
            (SETQ IP (GETPOINT "\n请输入左下角点(left_down point): ?"))
            (SETQ A (GETDIST "\nX_length方向长: ?--- "))
            (SETQ B (GETDIST "\nY_length方向长: ?--- "))
            (COMMAND "LINE" IP (LIST (+ A (CAR IP)) (CADR IP))
            (LIST (+ A (CAR IP)) (+ B (CADR IP)))
            (LIST (CAR IP) (+ B (CADR IP)))  "C")
      (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
   (prin1)

         )
(DEFUN C:R2(/ ip ss)
(prompt "               ------画任意距形-----")
                  (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
;(setvar "osmode" 0)
            (SETQ IP (GETPOINT "\n请输入左下角点(first point): ?"))
            (SETQ SS (GETCORNER ip "\n请输入右上角点(secand point): ?\n" ))
            (COMMAND "LINE" IP (LIST (CAR SS) (CADR IP))
            (LIST (CAR SS) (CADR SS))
            (LIST (CAR IP) (CADR SS)) "C")
         (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
   (prin1)
         )
(DEFUN C:R180()
            (COMMAND "ROTATE" PAUSE PAUSE PAUSE "180"))
(DEFUN C:R90()
            (setvar "cmdecho" 1)
            (COMMAND "ROTATE" PAUSE PAUSE PAUSE "90"))

(setq rr_1 50)
(defun c:gx(/ d i ss tt c e v xx)
(prompt"\n可按层,按颜色,按实体改线宽")
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)




(setq olderr  *error*             ; Initialize variables
         *error* aaa)
(prompt "\n一般选择可用窗口选 如C,W\n")
     (princ "请设置线宽(width)<")
(princ rr_1)
  (setq d (getreal ">:?"))
(if (/= d nil)(setq rr_1 d))
(prompt "\n请选择要修改的实体<--->")
   (initget "a b A B ")
(setq i (getkword "A--按实体类型选择,B--一般选择\n请选择<B>(A or B) "))
(cond ((or (eq i "a")(eq i "A"))
                 (setq ss (xc)))

     ((or (eq i "b")(eq i "B"))
        (setq ss (ssget)))
       (T (setq ss (ssget)))
     )

(setq tt (sslength ss))
(setq c 0)
(repeat tt
     (setq e (ssname ss c))
(setq v (entget e))
(setq xx (cdr (assoc 0 v)))
(cond ((or (= xx "POLYLINE")(= xx "LWPOLYLINE"))(command "pedit" e "w" rr_1 ""))
    ((or (= xx "ARC")(= xx "LINE"))(command "pedit" e "y" "w" rr_1 ""))
; (if (or (/= xx "POLYLINE")(/= xx "LINE")(/= xx "ARC")) (prompt "不能编辑此实体"))
)
     (setq c (1+ c))
  )
  (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
   (prin1)

  )

(DEFUN C:gs()
(setq ss (entsel "select objet:?"))
(setq zs (getstring "\n新数(what):?\n"))
(setq ss (car ss))
(setq a1 (assoc 1 (entget ss)))
(setq aa (cons '1 zs))
(setq a2 (subst aa a1 (entget ss)))
(entmod a2)
(prin1)
)

(defun c:gzx(/ s_1 zs)
(setq s_1 (ssget))
(setq zs (getstring "\n新字形(style): ?"))
(setq c 0)
(setq le (sslength s_1))
(repeat le
  (setq se (ssname s_1 c))

;(setq s_1 (ssname s_1 0))
(entmod (subst (cons '7 zs) (assoc 7 (entget se)) (entget se)))
(setq c (1+ c))
)
(prin1)
)
(defun c:gzg(/ s_1 zs)
(setq s_1 (ssget))
(setq zs (getreal "\n输入新的字高(height): ?"))
(setq c 0)
(setq le (sslength s_1))
(repeat le
  (setq se (ssname s_1 c))

;(setq s_1 (ssname s_1 0))
(entmod (subst (cons '40 zs) (assoc 40 (entget se)) (entget se)))
(setq c (1+ c))
))
(if (/= atomlist nil)(progn
     (setq atomlist (cdr atomlist))
     (setq atomlist (cdr atomlist))
    )
)
(defun c:TIN(/ txt sp ht1 ins wd stl ls dt)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

(setq txt (open(getstring "\n 请输入文件名(filename):?") "r"))

(setq sp (getpoint "\n插入基点please give a point:? "))
(setq ht (getvar "dimtxt"))
(princ "\n输入字高height<")
(princ ht)
(setq ht1 (getdist sp ">:? "))
(if (/= ht1 nil)(setq ht ht1))
(princ "\nheight=")
(princ ht)
(princ "\n输入行间距hang_ju<")
(setq ins (* 1.25 ht))
(princ ins)
(setq ins (getreal ">:? "))
(if (= ins nil)(setq ins (* 1.2 ht)))
(setq ins (rtos ins 2 3))


(setq dt  (read-line txt))

(command "text" sp ht "0" dt)

(while (/= dt nil)
  
  (setq dt (read-line txt))
  
  (setq ls (strcat "@" ins"<-90"))
  
  (command "text" ls ht "0" dt)
)
(close txt)
(command "redraw")
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

)
(defun gxrs(cu_hh string cu_chi / cu1)
  (princ string)
  (princ "<")
   (princ cu_hh)
   (setq cu1 (getstring ">:? "))
(if (/= cu1 "")(setq cu_hh cu1))
(eval ch_hh)
)

(defun gxri(cu_hh string cu_chi / cu1)
  (princ string)
  (princ "<")
   (princ cu_hh)
   (setq cu1 (getint ">:? "))
(if (/= cu1 "")(setq cu_hh cu1))
(eval ch_hh)
)


(defun gxrr(cu_hh string cu_chi / cu1)
  (princ string)
  (princ "<")
   (princ cu_hh)
   (setq cu1 (getreal ">:? "))
(if (/= cu1 "")(setq cu_hh cu1))
(eval ch_hh)
)


(defun gxrd(cu_hh string cu_chi / cu1)
  (princ string)
  (princ "<")
   (princ cu_hh)
   (setq cu1 (getdist cu_chi ">:? "))
(if (/= cu1 "")(setq cu_hh cu1))
(eval ch_hh)
)


(defun gxrp(cu_hh string cu_chi / cu1)
  (princ string)
  (princ "<")
   (princ cu_hh)
   (setq cu1 (getpoint ">:? "))
(if (/= cu1 "")(setq cu_hh cu1))
(eval ch_hh)
)


(defun c:xhz(/ pp ht1 xx xh txt sd)
             (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setq ht (getvar "dimtxt"))
(setq pp (getpoint "\nplease a point:? "))
(princ "\nheight<")
(princ ht)
(setq ht1 (getdist pp ">:? "))
(if (/= ht1 nil)(setq ht ht1))
(princ "\nheight=")
(princ ht)
(princ "\nhang_ju<")
(setq xx (* 1.5 ht))
(princ xx)
(setq xh (getreal ">:? "))
(if (= xh nil)(setq xh (* 1.2 ht)))
(setq xh (rtos xh 2 3))
(command "edit" "dat1")
(setq txt (open "dat1" "r"))
(setq sd (read-line txt))
(command "text" pp ht "0" sd)
(while (/= sd nil)
(setq pp (strcat "@" xh "<-90"))
(setq sd (read-line txt))
(command "text" pp ht "0" sd)
  )
(close txt)
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

)
(defun xcc(num / ss len c sr s1 lay enty sb coll sl)
;(setq num (getint "\nwhat color:? "))
(setq ss (ssget "x" (list (cons 62 256))))
(setq len (sslength ss))
(setq c 0)
(setq sr (ssadd))
(repeat len
   (setq s1 (ssname ss c))
   (entnext s1)

   (setq lay (cdr (assoc 8 (entget s1))))
    (setq enty (cdr (assoc 0 (entget s1))))
    (setq sb (tblsearch "layer" lay))
    (setq coll (cdr (assoc 62 sb)))
    (if (= coll num)
       (setq sl (ssadd s1 sr))
        )
      (setq c (1+ c))
)
(eval sl)


)



(setq ht 2.0)
(defun C:bzxx(/ pt1 pt2 pt3 hei pt1x pt1y spt1x spt1y ang l_len
          styl s_ss z_k   pt3 pt4 rpt1 ang1 ang2 pp1 pp2 angd)
     (princ "请输入字高<")
     (princ ht)
(tou)
(setq hei (getreal ">:?"))
(if (/= hei nil)(setq ht hei))
     (command "osnap" "off")
     (setq pt1 (getpoint "\n请输入标注点:?"))
     (setq pt2 (getpoint pt1 "\n起点位置:?"))
     (command "line" pt1 pt2 "")
     (setq pt3 (getpoint pt2 "\n方向:?"))
     (setq pt1x (car pt1))
     (setq pt1y (car (cdr pt1)))
     (setq spt1x (strcat "X " (rtos pt1x 2 3)))
     (setq spt1y (strcat "Y " (rtos pt1y 2 3)))

(setq styl (getvar "TEXTSTYLE"))
(setq s_ss (tblsearch "style" styl))
(setq z_k (cdr (assoc 41 s_ss)))


(setq ang (angle pt2 pt3))

(setq l_len (* (* (- (max (strlen spt1x) (strlen spt1y)) 1) ht) z_k))

(setq pt4 (polar pt2 ang l_len))
(command "line" pt2 pt4 "")

(if (and (> ang (/ pi 2)) (<= ang (* (/ pi 2) 3.0))) (progn
         (setq rpt1 pt4)
         (setq ang1 (angle pt4 pt2))
       )
     )
     (if (or (<= ang (/ pi 2)) (> ang (* (/ pi 2) 3.0))) (progn
         (setq rpt1 pt2)
         (setq ang1 (angle pt2 pt4))
       )
     )
(setq pp1 (polar rpt1 (+ ang1 (/ pi 2)) (/ ht 3)))
(setq pp2 (polar rpt1 (- ang1 (/ pi 2)) (+ ht (/ ht 3))))
(command "osnap" "off")
     (setq angd (* (/ ang1 pi) 180.0))
     (command "text" pp1   ht angd spt1x)
     (command "text" pp2  ht angd spt1y)
(wei)
)


(SETQ HT 2.0)


(defun C:bzyx(/ hei pt1 pt2 pt3 rpt1 pt1x pt1y spt1x spty ang
         styl s_ss z_k  l_len pt4 ang1 pp1 pp2 angd)
   (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)

     
   
     (princ "请输入字高(text height)<")
     (princ ht)
(setq hei (getreal ">:\n"))
(if (/= hei nil)(setq ht hei))
     (setq pt1 (getpoint "\n请输入标注点(get point):?"))
     (setvar "osmode" 0)
     (setq pt2 (getpoint pt1 "\n起点位置(where):?"))
     (command "line" pt1 pt2 "")
    ; (setq b1 (entget (car (entsel"Select line to paralel:\n"))))
     (setq pt3 (getpoint pt2 "\n方向(which way):?"))
     (setq rpt1 (reverse pt1))
     (setq pt1x (cadr rpt1))
     (setq pt1y (caddr rpt1))
     (setq spt1x (strcat "X " (rtos pt1x 2 3)))
     (setq spt1y (strcat "Y " (rtos pt1y 2 3)))
(setq ang (angle pt2 pt3))

(setq styl (getvar "TEXTSTYLE"))
(setq s_ss (tblsearch "style" styl))
(setq z_k (cdr (assoc 41 s_ss)))
(setq l_len (* (* (- (max (strlen spt1x) (strlen spt1y)) 2) ht) z_k))
(setq pt4 (polar pt2 ang l_len))
(command "line" pt2 pt4 "")
(if (and (> ang (/ pi 2)) (<= ang (* (/ pi 2) 3.0))) (progn
         (setq rpt1 pt4)
         (setq ang1 (angle pt4 pt2))
       )
     )
     (if (or (<= ang (/ pi 2)) (> ang (* (/ pi 2) 3.0))) (progn
         (setq rpt1 pt2)
         (setq ang1 (angle pt2 pt4))
       )
     )
(setq pp1 (polar rpt1 (+ ang1 (/ pi 2)) (/ ht 3)))
(setq pp2 (polar rpt1 (- ang1 (/ pi 2)) (* 1.33 ht)))
     (setq angd (* (/ ang1 pi) 180.0))
     (command "text" pp1   ht angd spt1x)
     (command "text" pp2  ht angd spt1y)
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

(prin1)

)





(defun c:tout();(/ oldech filstr txt yn)
   (setq olderr  *error*             ; Initialize variables
         *error* aaa)


(prompt "\n    将图形文字写入文件")   
(prompt "\n            1995.4.15.00:23")
    (setq oldech (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (setq filstr (getstring "\n文件名input filename:? "))
(setq txt (open filstr "r"))
;(setq txt1 (read-line txt))
(if (/= txt nil)(progn
        (close txt)   
(princ (strcat "\n 文件名"  "\"" filstr "\"" "  已经存在."
                              " 是否覆盖"))

(princ (strcat "\n!!!!!! the specified file "  "\"" filstr "\"" "  already exists."
                              "\n   do you want overwrite it<N>?"))
(setq yn (getstring))
(if (or (= (strcase yn) "N") (= yn ""))
        (setq filstr "")
                        
  )  
  )
  )
   
   
    (if (/= filstr "")
        (export)
    )
    (setvar "cmdecho" oldech)
    (princ)
)


(defun export(/ method ll ur lines xpfile total alist blist test)
   
    (setq lines (ssget))

;-------------------------------------
(setq xpfile (open filstr "w"))
(SETQ total (1- (sslength lines)))
;--------------------------------
(princ "总计(total)  ")
(princ (+ 1 total))
(princ "  行   ")                  
                  ; (setq blist nil)
         (while (<= 0 total)
             (prin1 '-)
             (setq alist (entget (ssname lines total)))
             (if (= "TEXT" (cdr (assoc 0 alist)))
                       ;(setq blist (cons (cdr assoc 1 alist) blist)))
                       ; )   
              
              (write-line (cdr (assoc 1 alist)) xpfile)
                )              
                 (setq total (1- total))
           )
    (close xpfile)
    (prompt (strcat "\n写文件(File) " "\"" (strcase filstr) "\"" " 成功(written).\n"))
)




(DEFUN C:GYS(/ WK SS SSE LEN C EE E1)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setvar "cmdecho" 0)

(SETQ WK (GETint "What color:? "))
(SETQ SS (SSGET))
(SETQ LEN (SSLENGTH SS))
(SETQ C 0)
(REPEAT LEN
    (SETQ SSE (SSNAME SS C))
  (command "change" sse "" "p" "c" wk "")

  (SETQ C (1+ C))
  )
  (setvar "cmdecho" joj)
(setq *error* olderr)
   (prin1)

  )
(SETQ BL 1)
(defun c:dm(/ BL1 SS SS1 EE NAME WD P1 P2 DISS DISS1 ANG P3 P4 P5)
  (PROMPT "\nPLEASE TYPE \"DM1\" IN THE COMMAND ")
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
     (setvar "osmode" 512)


  (setq bl (/ (getvar "dimtxt") 2.5))
  (setq ss (entsel "\nselect object:? "))
  (setq ss1 (car ss))
  (setq ee (entget ss1))
  (setq name (cdr (assoc  0 ee)))

(if (OR (= name "POLYLINE")(= name "LWPOLYLINE"))(PROGN
     (SETQ WD (CDR (ASSOC 40 EE)))
     (COMMAND "EXPLODE" SS1)
    (setq ee (entGET(ENTLAST)))   
     )
  )
  (setq p1 (cdr (assoc 10 ee)))
  (setq p2 (cdr (assoc 11 ee)))   
  (setq diss (* bl 5) diss1 (* bl 12))
  (setq ang (angle p1 p2))
  (setq p3 (polar p1 (+ ang (/ pi 2)) diss))
  (setq p4 (polar p2 (+ ang (/ pi 2)) diss))
  (setq p5 (polar p1 (+ ang (/ pi 2)) diss1))

  (command "dim" "ali" p3 p4 p5 "" "e")

(if (OR (= name "POLYLINE")(= name "LWPOLYLINE"))(PROGN
   (SETQ SS (CAR (CDR SS)))
;   (PRINC SS)
   (COMMAND "PEDIT" SS "Y" "W" WD "X")
                         )
           )

   (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)

   )


(DEFUN C:GZk(/ WK SS LEN C SSE EE E1)
(PROMPT "\n比例因子即为字宽同字高的比例关系")
(SETQ WK (GETREAL "\n比例因子SCALE...:? "))
(SETQ SS (SSGET))
(SETQ LEN (SSLENGTH SS))
(SETQ C 0)
(REPEAT LEN
    (SETQ SSE (SSNAME SS C))
     (SETQ EE (ASSOC 41
              (SETQ E1 (ENTGET SSE))
              )        )
     (ENTMOD
         (SUBST
            (CONS 41 WK)
            EE
            E1
            )
     )
  (SETQ C (1+ C))
  )
  )

(setq dis 240 colo 2 lay_1 "0")
(defun c:ofc(/ ss_1 sspo dis1 colo1 pp1)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
(setq ss_1 (entsel "\n选取要偏移的实体(seltct object): ?"))
(setq sspo (CAR (cdr ss_1)))
(princ "\n偏移距离(offset dist)<")
(princ dis)
(setq dis1 (getreal ">:?"))
(if (/= dis1 nil)(setq dis dis1))
(setq pp1 (getpoint "\n方向(which way):? "))
(princ "\n颜色号(color number)<")
(princ colo)
(setq colo1 (getint ">:?"))
(if (/= colo1 nil)(setq colo colo1))

(command "offset" dis sspo PP1 "")
(command "change" "l" "" "p" "C" colo "")
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
)

(defun c:ofl();(/ ss_1 sspo dis1 colo1 colo2 pp1)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
(setq ss_1 (entsel "\n选取要偏移的实体select object : ?"))
(setq sss (car ss_1))
(setq sspo (CAR (cdr ss_1)))
(princ "\n偏移距离(dist)<")
(princ dis)
(setq dis1 (getreal ">:?"))
(if (/= dis1 nil)(setq dis dis1))
(setq pp1 (getpoint sspo "\n方向(which way):? "))
(princ  "\n层号(layer)<")
(princ lay_1)
(setq colo2 (getstring ">:?"))
(if (/= colo2 "")(setq lay_1 colo2))
;(setq colo (cdr (assoc 62 (entget sss))))
(princ "\n颜色号(color number)<")
(princ colo)
(setq colo1 (getint ">:?"))
(if (/= colo1 nil)(setq colo colo1))

(command "offset" dis sspo PP1 "")
(command "layer" "n" lay_1 "")
(command "change" "l" "" "p" "la" lay_1 "")
(command "change" "l" "" "p" "C" colo "")  
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
)





(defun c:d90(/ le ee ent p1 p2 pz ss ss1 c leng dis)
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)


    (prompt "       -----镜像后尺寸斜线旋转90度(可用窗口选择)----\n")
   (prompt "dim_line rotate_90: guobangyi 1995.05.10 ZhangNanShiZhengSheJiYuan\n")
   (prompt "          \"leng\" is ---- int number ---\n")
   (setq le (getint "Dim_line leng<Enter to select dim_line>:? "))
   (if (= le nil)(progn
          (setvar "osmode" 512)
           (setq ss1 (entsel "\nselect the dim_line:? "))
          (setq ssa (car ss1))
          (setq ee (entget ssa))
          (setq ent (cdr (assoc 0 ee)))

(if (OR (= ent "POLYLINE")(= ent "LWPOLYLINE"))(PROGN
     (SETQ WD (CDR (ASSOC 40 EE)))
     (COMMAND "EXPLODE" ssa)
    (setq las (entlast))
    (setq ee (entGET las))
     )
  )





                 (setq p1 (cdr (assoc 10 ee)))
                 (setq p2 (cdr (assoc 11 ee)))
                 (setq pz (list (/ (+ (car p1) (car p2)) 2)
                                (/ (+ (nth 1 p1) (nth 1 p2)) 2)   
                          )
                 )
                 (if (or (= ent "LWPOLYLINE")(= ent "POLYLINE"))
   (COMMAND "PEDIT" las "y" "W" WD "X")
           )





                 (setq le (distance p1 p2))
              ;   (setq le (fix dis))
                  (princ "\n----the dim_line is ")
                  (princ le)
                  (princ " ----\n")
            )
         (setvar "osmode" 0)
         )

      (princ le)
   (princ "---select object to change---\n")
   (setq ss (ssget))
     (setq leng (sslength ss))
     (setq c 0 n 0)
     (repeat leng
          (setq ssa (ssname ss c))
          (setq ee (entget ssa))
          (setq ent (cdr (assoc 0 ee)))
(if (OR (= ent "POLYLINE")(= ent "LWPOLYLINE"))(PROGN


     (SETQ WD (CDR (ASSOC 40 EE)))
     (COMMAND "EXPLODE" ssa)
    (setq ssa (entlast))
    (setq ee (entGET ssa))
     )
  )




                 (setq p1 (cdr (assoc 10 ee)))
                 (setq p2 (cdr (assoc 11 ee)))
                 (setq pz (list (/ (+ (car p1) (car p2)) 2)
                                (/ (+ (nth 1 p1) (nth 1 p2)) 2)   
                          )      
                   )         
                 (setq dis (distance p1 p2))
             ;    (setq dis (fix dis))



                 (if (equal le dis 0.01)(progn
                      (setq n (1+ n))
                     (command "rotate" ssa "" pz "90")
                 )              )
                        (if (OR (= ent "POLYLINE")(= ent "LWPOLYLINE"))
   (COMMAND "PEDIT" ssa "y" "W" WD "X")
           )

        (setq c (1+ c))
       )
(princ " \n       ----- ")
(princ n)
(princ " dim_line is changed -----\n")
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

(prin1)

)
















(defun c:bzb(/ pa aa bg bg1  1 p2 p3 p4 p5 p6)
              (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

    (setq pa (getpoint "\n请点取标注点(pick a point):? "))
    (setq aa (getvar "dimtxt"))
    (setq bg "%%p0.000")
    (princ "\n标高(biao_gao)<")
    (princ bg)
    (setq bg1 (getstring ">:? "))
    (if (/= bg1 "")(setq bg bg1))
    (setq p1 (polar pa pi (* 3 aa)))
    (setq p2 (polar pa 0 (* 1.5 aa)))
    (setq p3 (polar pa (* (/ pi 4) 3) (* 1.414 aa)))
    (setq p5 (polar pa (/ pi 4) (* 1.414 aa)))
    (setq p6 (polar p5 (/ pi 2) (/ aa 3.5)))
    (setq p4 (polar p5 0 (* aa 4.5)))
    (command "line" p1 p2 "")
    (command "line" pa p3 "")
    (command "line" pa p5 "")
    (command "line" p3 p4 "")
    (command "text" p6 aa "0" bg)
  (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
      )
(defun c:bza(/ pa aa bg bg1 p1 p2 p3 p4 p5 p6)
              (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

    (setq pa (getpoint "\n请点取标注点(pick a point):? "))
    (setq aa (getvar "dimtxt"))
    (setq bg "%%p0.000")
    (princ "\n标高(biao_gao)<")
    (princ bg)
    (setq bg1 (getstring ">:? "))
    (if (/= bg1 "")(setq bg bg1))
    (setq p1 (polar pa 0 (* 3 aa)))
    (setq p2 (polar pa pi (* 1.5 aa)))
    (setq p3 (polar pa (* (/ pi 4) 3) (* 1.414 aa)))
    (setq p5 (polar pa (/ pi 4) (* 1.414 aa)))
    (setq p4 (polar p3 pi (* aa 4.5)))
    (setq p6 (polar p4 (/ pi 2) (/ aa 3.5)))
    (command "line" p1 p2 "")
    (command "line" pa p3 "")
    (command "line" pa p5 "")
    (command "line" p5 p4 "")
    (command "text" p6 aa "0" bg)
      (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
      )
(defun c:gbg(/ xs )
(TOU)
;(setq ss1 (entsel "选择原数:? "))
(setvar "cmdecho" 0)
(setq xs (getstring "新数(what):? "))
(princ  "\n选择原数select object:? ")
(command "attedit" "" "" "" "" pause "" "v" "r" xs "")
(wei)
)

(defun c:bzax(/ pa aa bg bg1 p1 p2 p3 p4 p5 p6)
              (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

    (setq pa (getpoint "\n请点取标注点(pick a point):? "))
    (setq aa (getvar "dimtxt"))
    (setq bg "%%p0.000")
    (princ "\n标高(biao_gao)<")
    (princ bg)
    (setq bg1 (getstring ">:? "))
    (if (/= bg1 "")(setq bg bg1))
    (setq p1 (polar pa 0 (* 3 aa)))
    (setq p2 (polar pa pi (* 1.5 aa)))
    (setq p3 (polar pa (* (/ pi 4) 5) (* 1.414 aa)))
    (setq p5 (polar pa (- (/ pi 4)) (* 1.414 aa)))
    (setq p4 (polar p3 pi (* aa 4.5)))
    (setq p6 (polar p4 (- (/ pi 2)) (+ (/ aa 3.5) aa)))
    (command "line" p1 p2 "")
    (command "line" pa p3 "")
    (command "line" pa p5 "")
    (command "line" p5 p4 "")
    (command "text" p6 aa "0" bg)
      (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
      )
(defun c:bzbx(/ pa aa bg bg1 p1 p2 p3 p4 p5 p6)
              (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)

    (setq pa (getpoint "\n请点取标注点(pick a point):? "))
    (setq aa (getvar "dimtxt"))
    (setq bg "%%p0.000")
    (princ "\n标高(biao_gao)<")
    (princ bg)
    (setq bg1 (getstring ">:? "))
    (if (/= bg1 "")(setq bg bg1))
    (setq p1 (polar pa pi (* 3 aa)))
    (setq p2 (polar pa 0 (* 1.5 aa)))
    (setq p3 (polar pa (* (/ pi 4) 5) (* 1.414 aa)))
    (setq p5 (polar pa (- (/ pi 4)) (* 1.414 aa)))
    (setq p4 (polar p5 0 (* aa 4.5)))
    (setq p6 (polar p5 (- (/ pi 2)) (+ (/ aa 3.5) aa)))
    (command "line" p1 p2 "")
    (command "line" pa p3 "")
    (command "line" pa p5 "")
    (command "line" p3 p4 "")
    (command "text" p6 aa "0" bg)
      (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
(prin1)
      )




(defun c:mcb(/ aa jq ht  wd p1 a b p2 p3 p4 dt p5 p6 txt)
(tou)
(setq olderr *error* *error* aaa)
(setvar  "cmdecho" 0)
(initget "Y y N")
(setq aa (getstring "改变有关的参数吗<字高350,行间距900,字宽度因子0.65>?<N>"))
(cond ((eq aa "Y")(progn
               (setq jq (getint "\n请输入行间距<--->"))
               (setq ht (getint "\n请输入字高<--->"))
               (setq wd (getreal "\n请输入字宽度因子<--->"))))
      ((eq aa "y")(progn
               (setq jq (getint "\n请输入行间距<--->"))
               (setq ht (getint "\n请输入字高<--->"))
               (setq wd (getreal "\n请输入字宽度因子<--->"))))
   (T (progn(setq ht '350)
       (setq jq '900)
       (setq wd '0.65)))
   )


(setq p1 (getpoint "请给出门窗表的左上角点(left_up point)--->\n"))
(command "line" p1 "@18000<0" "")
(setq a (getint "多少个门窗how much-->\n"))
(setq b (+ a 1))
(SETQ QQ (- 0 jq))
(command "array" p1 "" "r" b "" QQ)
(command "pedit" p1 "y" "w" "60" "" )
(setq a1 (* a jq))
(setq p2 (polar p1 (- 0 (/ PI 2)) A1))
(princ p2)
(command "pedit" p2 "Y" "w" "60" "")
(command "pline" p1 "w" "60" "" p2 "")
(command "pline" (list (+ (car p1) 1500) (cadr p1))
"w" "60" ""      (list (+ (car p2) 1500) (cadr p2)) "")
(command "pline" (list (+ (car p1) 5500) (cadr p1))
"w" "60" ""     (list (+ (car p2) 5500) (cadr p2)) "")
(command "pline" (list (+ (car p1) 12500) (cadr p1))
"w" "60" ""     (list (+ (car p2) 12500) (cadr p2)) "")
(command "pline" (list (+ (car p1) 14000) (cadr p1))
"w" "60" ""     (list (+ (car p2) 14000) (cadr p2)) "")
(command "pline" (list (+ (car p1) 18000) (cadr p1))
"w" "60" ""     (list (+ (car p2) 18000) (cadr p2)) "")
(setq p3 (list (+ (car p1) (/ jq 3))(- (cadr p1) (* 3 (/ jq 4)))))
(setq p4 (polar p3 0 1800))
(setq p5 (polar p4 0 4300))
(setq p6 (polar p5 0 6650))
(setq p7 (polar p6 0 3750))
(setq txt (open "dat1" "r"))
(setq dt (read-line txt))
(setq jq (rtos jq 2 3))
  (command "text" p3 ht "" dt)
      (repeat (- a 1)        
(setq dt (read-line txt))
           (setq ls (strcat "@" jq "<-90"))

   (command "text" ls ht "" dt)
   
   )     
   
(setq dt (read-line txt))
   (command "text" p4 ht "" dt)
      (repeat (- a 1)
         (setq dt (read-line txt))
           (setq ls (strcat "@" jq "<-90"))
             (command "text" ls ht "" dt)
       )     
(setq dt (read-line txt))
   (command "text" p5 ht "" dt)
      (repeat (- a 1)
         (setq dt (read-line txt))
           (setq ls (strcat "@" jq "<-90"))
             (command "text" ls ht "" dt)
       )     

(setq dt (read-line txt))
   (command "text" p6 ht "" dt)
      (repeat (- a 1)
         (setq dt (read-line txt))
           (setq ls (strcat "@" jq "<-90"))
             (command "text" ls ht "" dt)
       )     



(close txt)

;(tinn txt p3 ht jq)
;(setq txt (open "dat2" "r"))
;(tinn txt p4 ht jq)
;(setq txt (open "dat3" "r"))
;(tinn txt p5 ht jq)
;(setq txt (open "dat4" "r"))
;(tinn txt p6 ht jq )
;(setq txt (open "dat5" "r"))
;(tinn txt p7 ht jq )
(command "insert" "mct" p1 "" "" "")
(wei)
)


(setq f 3 d 1800 dd 59 a 240)
(defun c:km()
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
(princ "门洞方向\n")
(princ "1--左向(left_down) 2--右向(right_down) 3--向上(down_up) 4--向下(up_down) <")
(princ f)
(setq l (getint ">: "))
(if (/= l nil)(setq f l))
(princ "\n门洞宽(wide)<")
(princ d)
(setq o (getint ">: "))
(if (/= o nil)(setq d o))
(princ "\n墙线宽line_wide<")
(princ dd)
(setq dx (getreal ">: "))
(if (/= dx nil) (setq dd dx))
(princ  "墙厚(dist)<")
(princ a)
(setq j (getint ">: "))
(if (/= j nil)(setq a j))
(setq xk (getreal "门扇厚(door_wide)?<0>\n "))
(if (= xk nil) (setq xk 0))
(prompt "目前方式是---")
(princ f)
(prompt "---")
(princ "\nleft_down--(1,3) right_down--(2) left_up(4)) ")
(setq p1 (getpoint "\n请点取门洞左下角点(1,3)--> 右下角点(2)-->左上角点(4)--> "))
(setvar "osmode" 0)

(if (or (= f 1) (= f 2))(progn
                            (setq p3 (polar p1 (/ pi 2) a))
                            (setq p5 (polar p1 (/ pi 2) (/ a 2)))
                             )
                             )
(if (or (= f 3) (= f 4))(progn
                            (setq p3 (polar p1 0 a))
                            (setq p5 (polar p1 0 (/ a 2)))
                             )
                             )
(if (= f 1)(progn
               (setq p2 (polar p1 0 d))
               (setq p4 (polar p2 (/ pi 2) a))
               (setq p7 (polar p5 0 d))
               (setq w (getpoint "门扇开启方向(which way)? "))
               (if (> (cadr w) (cadr p1))
                            (progn
                               (if (> d 1000)(progn
                                   (setq p6 (polar p5 (/ pi 4) (/ d 2)))
                                   (setq p8 (polar p7 (/ (* pi 3) 4) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (/ pi 4) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

                (if (< (cadr w) (cadr p1))
                            (progn
                               (if (> d 1000)(progn
                                      (setq p6 (polar p5 (- (/ pi 4)) (/ d 2)))
                                   (setq p8 (polar p7 (* (/ pi 4) 5) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (- (/ pi 4)) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

           )
  )

(if (= f 2)(progn
               (setq p2 (polar p1 pi d))
               (setq p4 (polar p2 (/ pi 2) a))
               (setq p7 (polar p5 pi d))
               (setq w (getpoint "门扇开启方向(which way)? "))
               (if (> (cadr w) (cadr p1))
                            (progn
                               (if (> d 1000)(progn
                                   (setq p6 (polar p5 (* (/ pi 4) 3)(/ d 2)))
                                   (setq p8 (polar p7 (/ pi 4) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (* (/ pi 4) 3)d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

                (if (< (cadr w) (cadr p1))
                            (progn
                               (if (> d 1000)(progn
                                      (setq p6 (polar p5 (* (/ pi 4) 5) (/ d 2)))
                                   (setq p8 (polar p7 (- (/ pi 4)) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (* (/ pi 4) 5) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

           )
  )



(if (= f 3)(progn
               (setq p2 (polar p1 (/ pi 2) d))
               (setq p4 (polar p2 0 a))
               (setq p7 (polar p5 (/ pi 2) d))
               (setq w (getpoint "门扇开启方向(which way)? "))
                 (if (> (car w) (car p1))
                            (progn
                               (if (> d 1000)(progn
                                   (setq p6 (polar p5 (/ pi 4) (/ d 2)))
                                   (setq p8 (polar p7 (- (/ pi 4)) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (/ pi 4) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

                     (if (< (car w) (car p1))
                            (progn
                               (if (> d 1000)(progn
                                      (setq p6 (polar p5 (* (/ pi 4) 3) (/ d 2)))
                                   (setq p8 (polar p7 (* (/ pi 4) 5) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (* (/ pi 4) 3) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

           )
  )



(if (= f 4)(progn
               (setq p2 (polar p1 (* (/ pi 2) 3) d))
               (setq p4 (polar p2 0 a))
               (setq p7 (polar p5 (* (/ pi 2) 3) d))
               (setq w (getpoint "门扇开启方向(which way)? "))
               (if (> (car w) (car p1))
                            (progn
                               (if (> d 1000)(progn
                                   (setq p6 (polar p5 (- (/ pi 4))(/ d 2)))
                                   (setq p8 (polar p7 (/ pi 4) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (- (/ pi 4))d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

                (if (< (car w) (car p1))
                            (progn
                               (if (> d 1000)(progn
                                      (setq p6 (polar p5 (* (/ pi 4) 5) (/ d 2)))
                                   (setq p8 (polar p7 (* (/ pi 4) 3) (/ d 2)))
                                   (command "pline" p5 "w" xk "" p6 "")
                                   (command "pline" p7 "w" xk "" p8 "")
                                   )
                                      (progn
                                      (setq p6 (polar p5 (* (/ pi 4) 5) d))
                                      (command "pline" p5 "w" xk "" p6 "")
                                       )
                                )
                              )
                )

           )
  )


(command "break" p1 p2 "")
(command "break" p3 p4 "")
(command "pline" p1 "w" dd "" p3 "")
(command "pline" p2 "w" dd "" p4 "")
;(command "pline" p5 "w" xk "" p6 "")
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

)





(setq fx 1 ck 1800 xk 59 qh 240)
(defun c:kc()
          (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)
(princ "开窗方向\n")
(princ "1--左向(left_down) 2--右向(right_down) 3--向上(down_up) 4--向下(up_down) <")
(princ fx)
(setq fx1 (getint ">: "))
(if (/= fx1 nil)(setq fx fx1))
(princ "窗洞宽(window wide)<")
(princ ck)
(setq ck1 (getint ">: "))
(if (/= ck1 nil)(setq ck ck1))
(princ  "墙厚dist<")
(princ qh)
(setq qh1 (getint ">: "))
(if (/= qh1 nil)(setq qh qh1))
(princ "\n墙线宽(line wide)<")
(princ xk)
(setq xk1 (getreal ">: "))
(if (/= xk1 nil) (setq xk xk1))
(prompt "目前方式是---")
(princ fx)
(prompt "---")
(princ "\nleft_down--(1,3) right_down--(2) left_up(4)) ")
(setq p1 (getpoint "\n请点取窗洞左下角点(1,3)--> 右下角点(2)-->左上角点(4)--> "))
(command "osnap" "off")
(if (or (= fx 1) (= fx 2))(progn
                            (setq p3 (polar p1 (/ pi 2) qh))
                            (setq p5 (polar p1 (/ pi 2) (* (/ qh 8) 3)))
                            (setq p7 (polar p1 (/ pi 2) (* (/ qh 8) 5)))
                             )
                             )
(if (or (= fx 3) (= fx 4))(progn
                            (setq p3 (polar p1 0 qh))
                            (setq p5 (polar p1 0 (* (/ qh 8) 3)))
                            (setq p7 (polar p1 0 (* (/ qh 8) 5)))
                             )
                             )
(if (= fx 1)(progn
               (setq p2 (polar p1 0 ck))
               (setq p4 (polar p2 (/ pi 2) qh))
               (setq p6 (polar p2 (/ pi 2) (* (/ qh 8) 3)))
               (setq p8 (polar p2 (/ pi 2) (* (/ qh 8) 5)))
              )
       )
(if (= fx 2)(progn
               (setq p2 (polar p1 pi ck))
               (setq p4 (polar p2 (/ pi 2) qh))
               (setq p6 (polar p2 (/ pi 2) (* (/ qh 8) 3)))
               (setq p8 (polar p2 (/ pi 2) (* (/ qh 8) 5)))
              )
       )
(if (= fx 3)(progn
               (setq p2 (polar p1 (/ pi 2) ck))
               (setq p4 (polar p2 0 qh))
               (setq p6 (polar p2 0 (* (/ qh 8) 3)))
               (setq p8 (polar p2 0 (* (/ qh 8) 5)))
              )
       )
(if (= fx 4)(progn
               (setq p2 (polar p1 (- 0 (/ pi 2)) ck))
               (setq p4 (polar p2 0 qh))
               (setq p6 (polar p2 0 (* (/ qh 8) 3)))
               (setq p8 (polar p2 0 (* (/ qh 8) 5)))
              )
       )
;(command "offset" qh p1 p3 "")
(command "break" p1 (polar p1 (/ pi 4) 0.4))
(command "break" p2 (polar p2 (/ pi 4) 0.4))
(command "break" p3 (polar p3 (/ pi 4) 0.4))
(command "break" p4 (polar p4 (/ pi 4) 0.4))
(command "pline" p1 "w" xk xk p3 "")
(command "pline" p2 "w" xk xk p4 "")
(command "line" p5 p6 "")
(command "line" p7 p8 "")

(setq p (getpoint "请点起要加宽的线条<pick point--->\n"))
(command "pedit" p "y" "w" xk "")
(while (/= p nil)
(setq p (getpoint "请点起要加宽的线条<pick point--->\n"))
(command "pedit" p "y" "w" xk "")
)
(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)

)


(defun tinn(txt sp ht ins / wd stl ls dt)
   (setq olderr  *error*             ; Initialize variables
         *error* aaa)

(setvar "cmdecho" 0)
;(setq txt (open(getstring "\n 请输入文件名(filename):?") "r"))

;(setq sp (getpoint "\n插入基点please give a point:? "))
;(setq ht (getdist sp "\n输入字高height:? "))
;(princ "\nheight=")
;(princ ht)
;(princ "\n输入行间距hang_ju<")
;(setq ins (* 1.25 ht))
;(princ ins)
;(setq ins (getreal ">:? "))
;(if (= ins nil)(setq ins (* 1.2 ht)))
(setq ins (rtos ins 2 3))


(setq dt  (read-line txt))

(command "text" sp ht "" dt)

(while (/= dt nil)
  
  (setq dt (read-line txt))
  
  (setq ls (strcat "@" ins"<-90"))
  
  (command "text" ls ht "" dt)
)
(close txt)
(command "redraw")
)
(defun c:jd(/ joj ojo jddw jdd pt1)
(setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setq jddw (getvar "auprec"))
(setq jdd (getvar "aunits"))
(setvar "cmdecho" 1)
(setvar "osmode" 512)
(setvar "aunits" 1)
(setvar "auprec" 4)
(setq pt1 (getpoint "\npick a point between the lines:? "))
(command "dim" "ang" pt1 pause pause ^C "e")

(setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setvar "aunits" jdd)
(setvar "auprec" jddw)
(textscr)
(prin1)
)

(defun c:ml()
(princ "\n        ---------------------------------")
(prompt "\ngxx m1 ll m3 dmm 3dkc hb fk chx 3dcp lll 3dl maklib \n")
(prin1)
)
(defun c:gxx()                             ;(/ xx wk ss len c sse ee e1)
            (setq olderr  *error*             ; Initialize variables
         *error* aaa)
   (setq joj (getvar "cmdecho"))
(setq ojo (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 512)

  (prompt "\n1,2,3 ----  ----  ---- 4,5 ---- . ---- . ---- 6,7,8 ..........")
  (setq x_x1 1)
  (princ "\n请选择线型<")
  (princ x_x1)
  (setq xx (getint ">:?"))
  (if (/= xx nil)(setq x_x1 xx))
  (if (= xx 1)(setq wk "dashed"))
     (if (= xx 2)(setq wk "dashed2"))
      (if (= xx 3)(setq wk "dashedx2"))
        (if (= xx 4)(setq wk "center"))
         (if (= xx 5)(setq wk "center2"))
          (if (= xx 6)(setq wk "dot"))
           (if (= xx 7)(setq wk "dot2"))
            (if (= xx 8)(setq wk "dotx2"))


(SETQ SS (SSGET))
(SETQ LEN (SSLENGTH SS))
(SETQ C 0)
(REPEAT LEN
    (SETQ SSE (SSNAME SS C))
  (command "change" sse "" "p" "lt" wk "")
  (SETQ C (1+ C))
  )
  (setvar "cmdecho" joj)
(setvar "osmode" ojo)
(setq *error* olderr)
   (prin1)

  )




(defun w_j()
(setq wjm (getstring "\n新建图形文件名:?"))
(setq wenj (strcat wjm ".dwg"))
(setq Yn (findfile wenj))
(if (/= yn nil)(progn
        (princ "\n图形")
        (princ wenj)
        (princ"已经存在")
        (w_j)
        )
   )
(eval wjm)
)




(setq olslb "lib" pth "d:/2000/" s_name "slibtxt")
(defun c:maklib()
(w_j)
(setq pd (getpoint "图形插入点:?"))
(setq ss (ssget))
  (setq name (strcat pth wjm))
(command "mslide" name)
(command "wblock" wjm "" pd ss "")
(command "u")
(princ "\n幻灯片文件名将与图形文件名同名")
; (setq fname (getstring "\n幻灯片文件:?"))
(princ "\n幻灯片文件路径名<")
(princ pth)
(setq pth1 (getstring ">:?"))
(if (/= pth1 "")(setq pth pth1))

     (setq txt (open s_name "a"))
     (write-line name txt)
     (close txt)
  (setq mlx (strcat "slib " olslb "<" s_name))
  (command "sh" mlx)
  (setq word (strcat "[" olslb "(" wjm ")" "]" wjm))
  (setq txt (open "d:\2000\123.mnu" "a"))
  (write-line word txt)
  (close txt)
  (command "menu" "d:\2000\123")
  )
(defun c:3dcp()
(setvar "cmdecho" 0)
(command "osnap" "nea")
(setq pa (prompt "\n请选择要复制的实体:? "))
(setq sse (ssget))
(setq bg (getstring "\n三维实体基点标高:? "))
(setq gd (getdist "\n三维实体高度:? "))
(setq lay (getstring "\n三维实体层名:? "))

(setq len (sslength sse))
(setq c 0)
(command "osnap" "off")
(repeat len

(setq ss (ssname sse c))
(command "copy" ss "" "0,0,0" (strcat "@0,0," bg))
(setq lat (entlast))
(command "layer" "n" lay "")
(command "change" lat "" "p" "t" gd "la" lay "")
(setq c (1+ c))
)
)
(defun c:3dkc()        ;(/ poi1 poi2 chu_w d_h chu_h po1)
(setq poi1 (entsel "please point the frist point of window:?\n"))
(setq poi2 (getpoint "the second point:?\n"))
(setq chu_w (getdist "窗宽:? "))
(setq d_h (getdist "\n窗台高:? "))
(setq chu_h (getdist "\n窗高:? "))

(setq ss (car poi1))
(princ "\n  ss---")
(princ ss)
(setq sss (entget ss))
(princ "   sss---  ")
(princ sss)
(setq h (cdr (assoc 39 sss)))
(setq po1 (car (cdr poi1)))
(princ po1)
(setq ang (angle po1 poi2))
(setq p2 (polar po1 ang chu_w))
;(setq pz (list (/ (+ (car po1) (car p2)) 2) (/ (+ (nth 1 po1) (nth 1 p2)) 2)))
(command "break" po1 p2)
;(command "layer" "s" "wall" "")
(command "line" po1 p2 "")
(setq ss1 (entlast))
;(command "change" ss1 "" "p" "t" "0" "")
(setq h1 (- h chu_h d_h))
(setq xp (strcat "@0,0," (rtos (+ chu_h d_h) 2 3)))
(command "copy" ss1 "" "0,0,0" xp)
(setq s1 (entlast))
(command "change" s1 "" "p" "t" h1 "la" "wall2" "")
(command "copy" ss1 "" "0,0,0" (strcat "@0,0,"  (rtos d_h 2 3)))
(setq s1 (entlast))
(command "change" s1 "" "p" "t" chu_h "la" "chu1" "c" "5" "")

(command "change" ss1 "" "p" "t" d_h "la" "wall2" "")
)

(defun c:dmm(/ P1 P2 P3 qq x1 x2 y1 y2 STR len a xx n c pp)
(setq p1 (getpoint "\n起点:?"))
(setvar "orthomode" 1)
(setq p3 (getpoint p1 "\n尺寸线位置:? "))
(setq str (getstring "\n尺寸 3000*2000*1200*..............      "))
(setq x1 (car p1) y1 (nth 1 p1))
(setq x2 (car p3) y2 (nth 1 p3))
(if (and (= x1 x2) (> y2 y1)) (setq cch "1"))
(if (and (= x1 x2) (< y2 y1)) (setq cch "2"))
(if (and (< x1 x2) (= y2 y1)) (setq cch "3"))
(if (and (> x1 x2) (= y2 y1)) (setq cch "4"))
(setq len (strlen str))

(cond ((= cch "1")
                   (progn
                   (setq ang (/ pi 2))
                   (setq an "0")
                   (setq ml "hor")
                   )
        )
            ((= cch "2")
                   (progn
                   (setq ang (- (/ pi 2)))
                   (setq an "0")
                   (setq ml "hor")
                   )
            )
            ((= cch "3")
                   (progn
                   (setq ang (- pi))
                   (setq an "90")
                   (setq ml "ver")
                   )
        )
      
      
      
      
             ((= cch "4")
                   (progn
                   (setq ml "ver")
                   (setq ang 0)
                   (setq an "90")
                   )
            )
)

(setq n 1)
(setq a "")
(setvar "lastpoint" p1)
(while (/= xx "*")
       (setq xx (substr str n 1))
   (cond ((/= xx "*")
            (setq a (strcat a xx))
            )
      ((or (= xx "*")(= xx ""))
         (progn
          (setq p2 (strcat "@" a "<" an))
          (command "dim" ml p1 p2 )
             (setq pp (getvar "lastpoint"))
            (command p3 a)
          )
        )
      )
    (setq n (1+ n))
    )
  (setq c n)
           (setq a "")
(setvar "LASTPOINT" pp)
(repeat (+ len 1)
       (setq xx (substr str n 1))
    (cond ( (/= xx "*")
            (setq a (strcat a xx))
          )

       ( (or (= xx "*")(= xx nil))
       (progn
          (setq p2 (strcat "@" a "<" an))
          (command "con" p2 a)
       (setq a "")
          )
       )
     )
     (setq n (1+ n))
)
(command "e")
         )

(defun c:CP3(/ ss hd)
(setq ss (ssget))
(setq hd (getstring "\ndistance:? "))
(command "copy" ss "" "0,0" (strcat "@0,0," hd))
)
(defun c:m3(/ ss hd)
(setq ss (ssget))
(setq hd (getstring "\ndistance:? "))
(command "move" ss "" "0,0" (strcat "@0,0," hd))
)
(defun c:3dl(/ gd pa pb pc pd pa1 pb1 pc1 pd1)
(tou)
(setvar "osmode" 0)
(setq gd (getdist "\nheight:? "))

(setq pa (getpoint "\nfirst point:? "))
(setq pb (getpoint "\nsecond point:? "))
(setq pc (getpoint "\nthird point:? "))
(setq pd (getpoint "\nfourth point:? "))
(setq pa1 (list (nth 0 pa) (nth 1 pa) gd))
(setq pb1 (list (nth 0 pb) (nth 1 pb) gd))
(setq pc1 (list (nth 0 pc) (nth 1 pc) gd))
(if (/= pd nil)
(setq pd1 (list (nth 0 pd) (nth 1 pd) gd)))
(if (/= pd nil)(command "3dface" pa1 pb1 pc1 pd1 "")
              (command "3dface" pa1 pb1 pc1 "" "")
        )
(wei)
)

(defun c:ll(/ gd pa pb pc pd pa1 pb1 pc1 pd1)
(setq gd (getdist "\nheight:? "))
(setq pa (getpoint "\nfirst point:? "))
(setq pa1 (list (nth 0 pa) (nth 1 pa) gd))
(command "line" pa1)
(setq pb (getpoint "\nsecond point:? "))
(setq pb1 (list (nth 0 pb) (nth 1 pb) gd))
(command pb1)
(while (/= pb nil)
(setq pb (getpoint "\nnext point:? "))
(setq pb1 (list (nth 0 pb) (nth 1 pb) gd))
(command pb1)
(if (= pb nil)
(command "")

        )
)

    )

(defun c:hx()
(setq as (getstring "\nFile_name:?"))
(setq txt (open as "r"))
(setq a1 (read-line txt))
(setq a2 (read-line txt))
(command "pline" a1 "w" "0" "0" a2)
(while (/= a2 nil)
(setq a2 (read-line txt))
(command a2)
)
)
(DEFUN C:M1()
(setq ss (entsel "\nselect object:?"))
(setq se (car ss))
(COMMAND "DIM" "TEDIT" se pause)
(command "e")
)


(defun c:chx()
(setq s1 (entsel "\nselect old object:?"))
(setq s2 (entsel "\nselect new object:?"))
(setq ee (car s2))
(setq e1 (entget ee))
(setq ltl (cdr (assoc 6 e1)))
(if (= ltl nil)
(setq ltl (cdr (assoc 2 (tblnext "ltype" s2))))
)
(command "change" s1 "" "p" "lt" ltl "")
)

(defun c:fk()
(tou)
(setq ss (entsel "\nselect Dim_line:?"))
(setvar "osmode" 512)
(setq li (getpoint "\nselect int_line:?"))
(setq se (car ss))
(setq e1 (entget se))
(setq p1 (cdr (assoc 13 e1)))
(setq p2 (cdr (assoc 14 e1)))
(setq p3 (cdr (assoc 10 e1)))
(setq d1 (distance p3 li))
(setq dx (distance p3 p1))
(setq ang1 (angle p3 p1))
(setq ang2 (angle p3 li))
(setq an (abs (- ang2 ang1)))
(setq d (* dx (cos an)))


;(setq d (distance p1 p2))


(setq d2 (- d d1))
(setq ang (angle li p3))
(setq p4 (polar p1 ang d2))
               ; (setq p5 (polar p2 (+ ang pi) d1))

(command "erase" se "")

(command "dim" "ali" p1 p4  p3 ""  "con" p2 "" "e")
(wei)
)


(defun c:hb()
(setq ss1 (entsel "\nselect first Dim_line:?"))
(setq ss2 (entsel "\nselect second Dim_line:?"))
(setq se1 (car ss1))
(setq e11 (entget se1))
(setq p11 (cdr (assoc 13 e11)))
(setq p21 (cdr (assoc 14 e11)))
(setq p31 (cdr (assoc 10 e11)))
(setq se2 (car ss2))
(setq e12 (entget se2))
(setq p12 (cdr (assoc 13 e12)))
(setq p22 (cdr (assoc 14 e12)))
(setq p32 (cdr (assoc 10 e12)))
(setq q1x (nth 0 p11))
(setq q2x (nth 0 p21))
(setq q3x (nth 0 p12))
(setq q4x (nth 0 p22))
(setq q1y (nth 1 p11))
(setq q2y (nth 1 p21))
(setq q3y (nth 1 p12))
(setq q4y (nth 1 p22))
(cond ((= q1y q2y)(progn
     (setq pxma (max (nth 0 p11) (nth 0 p12) (nth 0 p21) (nth 0 p22)))
     (setq pxmi (min (nth 0 p11) (nth 0 p12) (nth 0 p21) (nth 0 p22)))
     (setq r1 (list pxma q1y))
     (setq r2 (list pxmi q1y))
                )
       )

((= q1x q2x)(progn
     (setq pxma (max (nth 1 p11) (nth 1 p12) (nth 1 p21) (nth 1 p22)))
     (setq pxmi (min (nth 1 p11) (nth 1 p12) (nth 1 p21) (nth 1 p22)))
     (setq r1 (list q1x pxma))
     (setq r2 (list q1x pxmi))
                )
       )
  (progn
     (setq pxma (max q1x q2x q3x q4x))
     (setq pxmi (min q1x q2x q3x q4x))
         (cond ((= pxma q1x)(setq r1 p11))
               ((= pxma q2x)(setq r1 p12))
               ((= pxma q3x)(setq r1 p21))
               ((= pxma q4x)(setq r1 p22))
               )
         (cond ((= pxmi q1x)(setq r2 p11))
               ((= pxmi q2x)(setq r2 p12))
               ((= pxmi q3x)(setq r2 p21))
               ((= pxmi q4x)(setq r2 p22))
               )
     )
)
(command "erase" se1 se2 "")
(command "dim" "ali" r1 r2 p31 "" "e")                                       
                                       
                                       )






(DEFUN C:1()
(ENTGET(ENTLAST)))
(prin1)

现在很想将其中几个子程序lisp单独提出来成单独的lisp程序，其名称如下：
gx---改线宽   gzg--改字高 gs---改数   gys----改颜色     gz---字替换   gzx--改字形   
gzk--改字宽，请各位大虾帮忙！

xjlmlxbq

这么丰盛的大餐，谢谢你的无私奉献

xcajcj

请问1楼的朋友：“ZCR.lsp”是你朋友编的吗？把你的朋友介绍给我们大家认识认识嘛！

dlldll

集合了好多东西，是个学习的好东西

wlwesley

利于学习研究