CAD快速修改线型的lisp程序

nfs538

(defun MODES (a);快速修改线形程序
   (setq MLST '())
   (repeat (length a)
      (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
      (setq a (cdr a))
   )
)
(defun MODER ()
   (repeat (length MLST)
      (setvar (caar MLST) (cadar MLST))
      (setq MLST (cdr MLST))
   )
)
(defun myerror (st)
   (if (/= st "Function cancelled")
       (princ (strcat "\nError: " st))
   )
   (moder)
   (setq *error* olderr)
   (princ)
)
(defun RTD (y)
   (* 180. (/ y pi))
)
(defun DTR (y)
   (* pi (/ y 180.))
)
(defun C:CText ()
   (setvar "BLIPMODE" 0)
   (setvar "CMDECHO" 0)
   (modes '("BLIPMODE" "CMDECHO"))
   (graphscr)
   (princ "lease select HZ style:")
   (initget 2 "Singleline-hz Doubleline-hz")
   (setq hz (getstring "\nSingleline-hz/Doubleline-hz/<standard-hz>:"))
   (cond ((eq hz "s")  (COMMAND "STYLE" "HZ" "TXT,HZTXT" "" "0.75" "" "" ""))
         ((eq hz "d")  (COMMAND "STYLE" "HZ1" "TXT,HZTXT1" "" "0.75" "" "" ""))
         ((eq hz "") (COMMAND "STYLE" "HZ0" "TXT,HZTXT0" "" "0.75" "" "" ""))
         (T (princ "Unknown HZ style !"))
         )
   (setq cst (getvar "textstyle"))
    (if (= interface nul) (setq interface "P"))
    (if (or (= interface "W") (= interface "w"))
        (princ "\nCurrent Interface is WBX")
        (princ "\nCurrent Interface is Py.")
    )
   (setq olderr *error*
         *error* myerror)
   (modes '("BLIPMODE" "CMDECHO"))
   (graphscr)
   (initget 1 "Center Fit Middle Right Interface")
   (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right/Interface :"))
   (if (/= (type pt) 'LIST)
      (if (= pt "Interface")
         (progn
              (initget  "Wbx Py")
              (setq interfaces (getkword  "\n Wbx or Py :"))
              (setq interface (substr interfaces 1 1))
              (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right:"))
           )
      )
   )
   (if (/= (type pt) 'LIST)
       (setq j (substr pt 1 1))
       (setq j "L")
   )
   (if (/= (type pt) 'LIST)
       (if (= pt "Fit")
           (progn
              (initget 1)
              (setq ptf (getpoint "Fist text line point: "))
              (setq pt ptf)
              (initget 1)
              (setq pts (getpoint "Second text line point: "))
              (setq k 1)
           )
           (progn
              (initget 1)
              (setq pt (getpoint (strcat "\n" pt " point: ")))
           )
       )
  )
  (initget 6)
  (setq h (getdist pt (strcat "\nHeight <"
                              (rtos (getvar "TEXTSIZE"))
                                ">: "
                      )
          )
   )
   (if (null h) (setq h (getvar "textsize")))
   (if (/= k 1)
    (progn
     (if (null a$$)
         (progn
           (if (= (cdr (assoc 70 ts)) 4)   ;Vertical style text
               (progn
                 (setq a$$ 270)
                 (prompt "\nRotational angle <270>: ")
               )
               (progn
                 (setq a$$ 0)
                 (prompt "\nRotational angle <0>: ")
               )
           )
         )
         (progn
           (prompt "\nRotational angle <")
           (princ (strcat (angtos a$$) ">: "))
         )
     )
     (setq ang (getangle pt))
     (if (null ang) (setq ang a$$))
     (setq a$$ ang)
    )
   )
  (if (or (= interface "P") (= interface "p")) (command "AVCAD")(command "AVCAD W"))
  (setq f (open "chstr.dat" "r"))
  (setq eoff 1)
  (setq st (read-line f))
  (cond ((and (= j "L") h)
           (while (= eoff 1)
                (command "TEXT" "s" cst pt h (rtd ang) st)
                (setq OLDx (car pt))
                (setq oldy (cadr pt))
                (setq newX (+ oldX (* (sin ANG) H (/ 1. 0.6))))
                (setq newy (- oldy (* (cos ANG) H (/ 1. 0.6))))
                (setq pt (list NEWX NEWY))
                (setq st (read-line f))
                (if (= st   nil)(setq eoff 2))
             )
         )
         ((and (/= j "L") (/= j "F") h)
          (command "TEXT" "s" cst j pt h (rtd ang) st)
         )
         ((and (/= j "L") (= j "F") h)
          (command "TEXT" "s" cst j ptf pts h st)
         )
      )
   (moder)
   (setq *error* olderr)
   (close f)
   (command "text" "s" cst ^c)
   (redraw)
   (princ)
)

(defun C:EPT (/ olds oldss olds1 stp h txt wf st x0 y0 l n yes
                TXTA TXT1 NN AR AD CL cst)
   (setq olderr *error*
         *error* myerror)
   (setvar "BLIPMODE" 0)
   (setvar "CMDECHO" 0)
   (SETQ CL (GETVAR "CLAYER"))
   (setq cst (getvar "textstyle"))
   (setq olds (entsel "\nSelect the string :"))
   (SETQ OLDSS (CAR OLDS))
   (setq olds (entget  (car  olds)))
   (setq olds1 (cdr (assoc 0 olds)))
   (if (= "TEXT" oldS1)
       ( progn
          (COMMAND "ERASE" (SSADD OLDSS) "")
          (COMMAND "LAYER" "S"  (CDR (ASSOC 8 OLDS)) "")
          (setq stp  (trans (cdr (assoc 10 olds)) 0 1))
          (setq h   (cdr (assoc 40 olds)))
          (setq aR (cdr (assoc 50 olds)))
          (setq aD  (RTD (cdr (assoc 50 olds))))
          (setq txt (cdr (assoc 1 olds)))
          (setq wf (Cdr (assoc 41 olds)))
          (SETQ ST (CDR (ASSOC 7 OLDS)))
          (SETQ X0 (CAR STP) Y0 (CADR STP))
          (setq l (strlen txt))
          (setq n 1) (setq nn 2)
          (setq yes 1)
          (while (<= N L)
                  (setq tXT1 (substr txt n 2))
                  (SETQ TXTA (ASCII TXT1))
                  (setq nn (cond
                            ((= TXT1 "%%") 3)
                            ((> Txta 160) 2)
                            ((< Txta 129) 1)
                           )
                  )
                  (setq txt1 (substr txt n nn))
                  (setq n (+ n nn))
                  (command "text" "S" ST stp h aD txt1)
                  (IF (= NN 2)
                      (PROGN
                         (cond ((eq cst "HZ")   (setq wscale 1.0625))
                               ((eq cst "HZ1")  (setq wscale 1.20))
                               ((eq cst "HZ0")  (setq wscale 1.40))
                              )
                         (SETQ X0 (+ X0 (* (cos aR)  H WF wscale)))
                         (SETQ y0 (+ Y0 (* (sin aR)  H WF wscale)))
                      )
                      (PROGN
                         (SETQ JF (COND
                                     ((= TXTA 49) 0.65)
                                     ((= TXTA 46) 0.3)
                                     (T 1)
                                  )
                          )
                         (setq wf1 (* JF WF))
                         (SETQ X0 (+ X0 (* (cos aR)  H WF1)))
                         (SETQ y0 (+ Y0 (* (sin aR)  H WF1)))
                      )
                   )
                  (SETQ STP (LIST X0 Y0))
         )
     )
  )
(COMMAND "LAYER" "S" CL "")
  (command "text" "s" cst ^c)
(setq *error* olderr)
(princ)
)
(DEFUN C:HZFILE(/ TXT SP TH INS WD STL LS DT)
(setvar "BLIPMODE" 0)
(SETVAR "CMDECHO" 0)
(modes '("BLIPMODE" "CMDECHO"))
(graphscr)
(SETQ TXT (OPEN (GETSTRING "\n Name of Text File(WordStar): ") "r"))
(SETQ SP (GETPOINT "\n Text String Start Point :"))
(SETQ INS (GETSTRING"\n Enter Line Spacing in Drawing Units :"))
(SETQ HT (GETSTRING "\n Enter Text Height in Drawing Units :"))
(SETQ WD (GETSTRING "\n Enter Text Width Factor :"))
(princ "Please select HZ style:")
(initget 2 "Singleline-hz Doubleline-hz")
(setq hz (getstring "\nSingleline-hz/Doubleline-hz/<standard-hz>:"))
(setq pname (getvar "dwgprefix"))
(cond ((eq hz "s")  (COMMAND "STYLE" "HZ" "txt,hztxt" HT WD "" "" ""))
      ((eq hz "d")  (COMMAND "STYLE" "HZ1" "txt,hztxt1" HT WD "" "" ""))
      ((eq hz "")   (COMMAND "STYLE" "HZ0" "txt,hztxt0" HT WD "" "" ""))
      (T (princ "Unknown HZ style ! Restart HZFILE command."))
      )
(SETQ DT (READ-LINE TXT))
(SETQ LS (STRCAT "@"INS"<-90"))
(COMMAND"TEXT" SP "" DT)
(WHILE (/= DT NIL)
(SETQ DT (READ-LINE TXT))
(COMMAND"TEXT" LS "" DT)
)
(COMMAND"REDRAW")
)
; For other Autolisp aplication
(DEFUN C:BOX () (LOAD "BOX")(C:BOX))
(DEFUN C:MXB () (LOAD "MXB")(C:MXB))
(DEFUN C:CL  () (LOAD "CL")(C:CL))
(DEFUN C:TH () (LOAD "TH")(C:TH))
(DEFUN CD  () (LOAD "LEADER")(C:LD))
(DEFUN C:CHGTEXT () (LOAD "CHGTEXT")(C:CHGTEXT))
(DEFUN C:LTEXT ()  (LOAD "LTEXT")(C:LTEXT))
(DEFUN C:LEXPLODE ()  (LOAD "LEXPLODE")(C:LEXPLODE))
(DEFUN SSX () (LOAD "SSX")(SSX))
;Setup environment
(DEFUN C:ENVIRON () (LOAD "ENVIRON")(C:ENVIRON))

;For clean memery
(defun C:CLEAN () (SETQ ATOMLIST (MEMBER 'C:CLEAN ATOMLIST)))
;For ctext, box ,mxb, ld ,...
(DEFUN S::STARTUP ()
   (setvar "cmdecho" 0)
   (setvar "blipmode" 0)
  (IF (= (TBLSEARCH "STYLE" "A") NUL)
       (COMMAND "STYLE" "A" "COMPLEX" "6" "0.8" "" "" "" ""))
  (IF (= (TBLSEARCH "STYLE" "HZ") NUL)
      (COMMAND "STYLE" "HZ" "TXT,HZTXT" "" "0.75" "" "" ""))
  (IF (= (TBLSEARCH "STYLE" "ASC") NUL)
      (COMMAND "STYLE" "ASC" "TXT" "" "0.75" "" "" "" ""))
  (IF (= (TBLSEARCH "LAYER" "1") NUL)
      (COMMAND "LAYER" "N" "1" "C" "1" "1" "LT" "CENTER" "1" ""))
  (IF (= (TBLSEARCH "LAYER" "4") NUL)
      (COMMAND "LAYER" "N" "4" "C" "4" "4" "LT" "" "1" ""))
  (IF (= (TBLSEARCH "LAYER" "5") NUL)
      (COMMAND "LAYER" "N" "5" "C" "6" "5" "LT" "" "5" ""))
  (setvar "textsize" 4.8)
   (princ)
)
;
(princ)
(defun c:p6 ()
(command "pedit" pause "width" "60" "exit" ))
(defun c:ft  ()
(setq x (getpoint "\n Pick axis crossing line to fillet:"))
(setq y (getpoint x "\n pick endpoint:"))
(setq sset1 (ssget "c" x y))
(setq ent1 (ssname sset1 0))
(setq ent2 (ssname sset1 1))
(setq en1 (entget ent1)
      en2 (entget ent2)
      pt1 (cdr (assoc 10 en1))
      pt2 (cdr (assoc 11 en1))
     int1 (inters x y pt1 pt2)
      pt3 (cdr (assoc 10 en2))
      pt4 (cdr (assoc 11 en2))
     int2 (inters x y pt3 pt4)
     enn1 (cdr (assoc -1 en1))
     enn2 (cdr (assoc -1 en2))
      et1 (list enn1 int1)
      et2 (list enn2 int2)
)
(command "fillet" et1 et2)
)
(defun c:kl ()
(setq pt0 (getpoint "\n line from:"))
(setq diss (getdist "\n Input line distance:"))
(setq angl   (getreal "\n Input line angle:"))
(setq dist (fix diss))
(setq angl_r (fix angl))
(setq ddf (strcat "@" (itoa dist) "<" (itoa angl_r)))
(command "line" pt0 ddf "")
)
(defun c:ls (/ dist scl dst sl)
(setq dist (getdist     "\n Pick the distance:"))
(setq scl (getreal "\n Input the drawingpaper implied:"))
(setq dst (/ dist scl))
(setq sl (/ 100 dst))
)
(defun c:tr1 ()
(setq trm1 (ssget))
(setq tt1 (ssname trm1 0))
(setq tr1 (entget tt1))
(setq pt1 (cdr (assoc 10 tr1)))
(setq pt2 (cdr (assoc 11 tr1)))
)
(defun c:tr2 ()
(setq trm2 (ssget))
(setq tt2 (ssname trm2 0))
(setq tr2 (entget tt2))
(setq pt3 (cdr (assoc 10 tr2)))
(setq pt4 (cdr (assoc 11 tr2)))
)
(defun c:r90 (/ gp) (setq gp (ssget)) (command "rotate" gp
"" pause "90"))
(defun c:r09 (/ gp) (setq gp (ssget)) (command "rotate" gp
"" pause "270"))
(defun c:r45 (/ gp) (setq gp (ssget)) (command "rotate" gp
"" pause "45"))
   (defun c:r54 (/ gp) (setq gp (ssget)) (command "rotate" gp
"" pause "315"))
(defun c:pm ()
(setq pt1 (getpoint "\n pick the pm point:"))
(setq pt2 (polar pt1 4.0492 759))
(command "pline" pt1 "width" "60" "60" "@702<270" "")
(command "text" "style" "romanc" pt2 "500" "0"))
(defun c:d9 ()
(command "insert" "d9" pause "" ""))
    (defun c:d12 ()
(command "insert" "d12" pause "" ""))
    (defun c:c3 ()
(command "insert" "c3" pause "" ""))
    (defun c:bg (/ pt1 pt2)
(setvar "osmode" 32)
(setq pt1 (getpoint "\n pick the bg point:"))
(setvar "osmode" 0)
(setq pt2 (polar pt1 0.89012 512))
(command "insert" "bg" pt1 "420" "" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
      (defun c:li () (command "line" "int"))
      (defun c:92 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 1.5708 2130))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@2130<90" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
    (defun c:920 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 4.7124 2130))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@2130<270" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
      (defun c:ln () (command "line" "nea"))
    (defun c:45 (/ pt0 pt1 pt2)
(setvar "osmode" 32)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 0.7854 1598))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@1598<45" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
     (defun c:60 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 1.0472 1305))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@1305<60" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
    (defun c:30 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 0.5236 2260))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@2260<30" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
     (defun c:90 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 1.5708 1130))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@1130<90" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
     (defun c:70 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 1.5708  830))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@830<90" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
     (defun c:600 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 5.236 1305))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@1305<-60" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
      (defun c:700 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 4.7124 830))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@830<-90" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
      (defun c:900 (/ pt0 pt1 pt2)
(setvar "osmode" 512)
(setq pt0 (getpoint "\n pick the implied steel:"))
(setq pt1 (polar pt0 4.7124 1130))
(setq pt2 (polar pt1 0.43633 280))
(setvar "osmode" 0)
(command "line" pt0   "@1130<-90" "@1200<0" "")
(command "text" pt2 "" "")
(setvar "osmode" 32))
    (defun c:t3 ()
(setvar "textsize" 300)
(command "text" pause "" ""))
(defun c:t4 ()
(setvar "textsize" 400)
  (command "text" pause "" ""))
(defun c:t7 ()
(setvar "textsize" 700)
(command "text" pause "" ""))
(defun c:t6 ()
(setvar "textsize" 600)
(command "text" pause "" ""))
(defun c:t5 ()
(setvar "textsize" 500)
(command "text" pause "" ""))
(defun c:HZ1 () (command "text" "STYLE" "HZ1") (command))
(defun c:HZ  () (command "text" "STYLE" "HZ")  (command))
(defun c:ro  () (command "text" "STYLE" "romanc") (command))
(defun c:lc () (command "line" "cen"))
(defun c:ce (/ sset)
(command "line" pause pause "")
(setq sset (ssget "l"))
(command "change" sset "" "p" "layer" "2" "ltype" "center" "")
)
(defun c:dde () (command "ddemodes"))
(defun c:sc () (command "scale"))
(defun c:dh () (command "dim1" "horiz" "nea" pause "nea" pause
"int"))
(defun c:dv () (command "dim1" "vertical" "nea" pause "nea" pause
"int"))
(DEFUN C:RG  () (COMMAND "REGEN"))
(DEFUN C:HI ()  (COMMAND "DIM1" "HORIZ" "INT" PAUSE "INT" PAUSE
"INT"))
(DEFUN C:VI () (COMMAND "DIM1" "VERTICAL" "INT" PAUSE "INT" PAUSE
"INT"))
(DEFUN C:FN () (COMMAND "FILL" "ON"))
(DEFUN C:FO () (COMMAND "FILL" "OFF"))
(defun C:uu () (command "units"))
(defun c:pp () (command "pedit" pause "y" "width" "60" "exit"))
(defun c:s0 () (command "layer" "set" "0" ""))
(defun c:s1 () (command "layer" "set" "1" ""))
(defun c:s2 () (command "layer" "set" "2" ""))
(defun c:s3 () (command "layer" "set" "3" ""))
(defun c:s4 () (command "layer" "set" "4" ""))
(defun c:s5 () (command "layer" "set" "5" ""))
(defun c:s6 () (command "layer" "set" "6" ""))
(defun c:s7 () (command "layer" "set" "7" ""))
(defun c:s8 () (command "layer" "set" "8" ""))
(defun c:s9 () (command "layer" "set" "9" ""))
(defun c:0  (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "0" ""))
(defun c:11 (/ gp) (setq gp (ssget)) (setvar "cmdecho" 1) (command
"change" gp "" "p" "la" "1" ""))
(defun c:22 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "2" ""))
(defun c:33 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "3" ""))
(defun c:44 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "4" ""))
(defun c:55 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "5" ""))
(defun c:66 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "6" ""))
(defun c:77 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "7" ""))
(defun c:88 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "8" ""))
(defun c:99 (/ gp) (setq gp (ssget)) (command
"change" gp "" "p" "la" "9" ""))
(defun C:ddd () (command "DDLMODES"))
(defun c:n () (command "donut" "0" ))
(defun c:t () (command "trim" "c" pause pause ""))
(defun c:ax () (command "axis"))
(defun c:sn () (command "snap" ""))
(defun C:te  () (command "text" pause "" ""))
(defun c:so () (command "solid"))
(defun c:tt  () (command "dtext" pause ""))
(defun C:ttt () (command "dtext"))
(defun c:wb   () (command "wblock"))
(defun c:pd () (command "pedit"))
(defun c:LL () (command "list"))
(defun c:di () (command "dist" ))
(defun c:dn () (command "dist" "nea" pause "nea"))
(defun c:de () (command "dist" "end" pause "end"))
(defun c:dd () (command "ddedit"))
(defun c:zz () (command "zoom" "extents"))
(defun c:1 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "1" ""))
(defun c:2 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "2" ""))
(defun c:3 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "3" ""))
(defun c:4 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "4" ""))
(defun c:5 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "5" ""))
(defun c:6 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "6" ""))
(defun c:7 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "7" ""))
(defun c:8 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "8" ""))
(defun c:9 (/ gp) (setq gp (ssget)) (command "change" gp ""
"p" "c" "9" ""))
(defun c:s   () (command "stretch" "c"))
(defun c:b   () (command "break" pause "f"))
(defun c:lll   (/ gp) (setq gp (ssget))(command "change" gp ""
"p" "lt" "continuous" ""))
(defun c:ccc (/ gp) (setq gp (ssget))(command "change" gp ""
"p" "lt" "center" ""))
(defun c:ss (/ gp) (setq gp (ssget))(command "change" gp "" "p"
"lt" "dashed" ""))
(defun c:g () (command "change"))
(defun c:mv () (command "move" "w"))
(defun c:k  (/ gp) (setq gp (ssget)) (command "copy" gp "" "m" ))
(defun c:gg  (/ gp) (setq gp (ssget)) (command "change" gp "" "p" "la"))
(defun c:kk () (command "copy" "p" "" "m" ""))
(defun c:jx ()
(setq pt1 (getpoint "pick first corner point:"))
(setq pt3 (getpoint "pick opposite corner:"))
(setq pt2 (list (nth 0 pt3) (nth 1 pt1)))
(setq pt4 (list (nth 0 pt1) (nth 1 pt3)))
(command "pline" pt1 pt2 pt3 pt4 "c")
)
(defun c:sl ()
(setq s (getreal "scale:"))
(setq a 1)
(while (<= a 100)
(setq pt1 (getpoint "pick first point:"))
(setq x0 (getreal "x"))
(setq y0 (getreal "y"))
(setq s1 (/ 100 s))
(setq X  (* x0 s1))
(setq y  (* y0 s1))
(setq u  (nth 0 pt1))
(setq v  (nth 1 pt1))
(setq x1 (+ x u))
(setq y1 (+ y v))
(setq pt2 (list x1 y1))
(command "line" pt1 pt2 "")
(setq a (+ 1 a))
))
(defun c:so ()
(setq s (getreal "scale:"))
(setq a (getreal "offset distance:"))
(setq s1 (/ 100 s))
(setq x  (* a s1))
(command "offset" x))
(defun MODES (a)
   (setq MLST '())
   (repeat (length a)
      (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
      (setq a (cdr a))
   )
)
(defun MODER ()
   (repeat (length MLST)
      (setvar (caar MLST) (cadar MLST))
      (setq MLST (cdr MLST))
   )
)
(defun myerror (st)
   (if (/= st "Function cancelled")
       (princ (strcat "\nError: " st))
   )
   (moder)
   (setq *error* olderr)
   (princ)
)
(defun RTD (y)
   (* 180. (/ y pi))
)
(defun DTR (y)
   (* pi (/ y 180.))
)
(defun C:ww()
   (setvar "BLIPMODE" 1)
   (setvar "CMDECHO" 0)
   (setq cst (getvar "textstyle"))
    (if (= interface nul) (setq interface "P"))
    (if (or (= interface "W") (= interface "w"))
        (princ "\nCurrent Interface is WBX")
        (princ "\nCurrent Interface is Py.")
    )
   (setq olderr *error*
         *error* myerror)
   (modes '("BLIPMODE" "CMDECHO"))
   (graphscr)
   (initget 1 "Center Fit Middle Right Interface")
   (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right/Interface :"))
   (if (/= (type pt) 'LIST)
      (if (= pt "Interface")
         (progn
              (initget  "Wbx Py")
              (setq interfaces (getkword  "\n Wbx or Py :"))
              (setq interface (substr interfaces 1 1))
              (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right:"))
           )
      )
   )
   (if (/= (type pt) 'LIST)
       (setq j (substr pt 1 1))
       (setq j "L")
   )
   (if (/= (type pt) 'LIST)
       (if (= pt "Fit")
           (progn
              (initget 1)
              (setq ptf (getpoint "Fist text line point: "))
              (setq pt ptf)
              (initget 1)
              (setq pts (getpoint "Second text line point: "))
              (setq k 1)
           )
           (progn
              (initget 1)
              (setq pt (getpoint (strcat "\n" pt " point: ")))
           )
       )
  )
  (initget 6)
  (setq h (getdist pt (strcat "\nHeight <"
                              (rtos (getvar "TEXTSIZE"))
                                ">: "
                      )
          )
   )
   (if (null h) (setq h (getvar "textsize")))
   (if (/= k 1)
    (progn
     (if (null a$$)
         (progn
           (if (= (cdr (assoc 70 ts)) 4)   ;Vertical style text
               (progn
                 (setq a$$ 270)
                 (prompt "\nRotational angle <270>: ")
               )
               (progn
                 (setq a$$ 0)
                 (prompt "\nRotational angle <0>: ")
               )
           )
         )
         (progn
           (prompt "\nRotational angle <")
           (princ (strcat (angtos a$$) ">: "))
         )
     )
     (setq ang (getangle pt))
     (if (null ang) (setq ang a$$))
     (setq a$$ ang)
    )
   )
  (if (or (= interface "P") (= interface "p")) (command "AVCAD")(command "AVCAD W"))
  (setq f (open "chstr.dat" "r"))
  (setq eoff 1)
  (setq st (read-line f))
  (cond ((and (= j "L") h)
           (while (= eoff 1)
                (command "TEXT" "s" "hz"  pt h (rtd ang) st)
                (setq OLDx (car pt))
                (setq oldy (cadr pt))
                (setq newX (+ oldX (* (sin ANG) H (/ 1. 0.6))))
                (setq newy (- oldy (* (cos ANG) H (/ 1. 0.6))))
                (setq pt (list NEWX NEWY))
                (setq st (read-line f))
                (if (= st   nil)(setq eoff 2))
             )
         )
         ((and (/= j "L") (/= j "F") h)
          (command "TEXT" "s" "hz"  j pt h (rtd ang) st)
         )
         ((and (/= j "L") (= j "F") h)
          (command "TEXT" "s" "hz"  j ptf pts h st)
         )
      )
   (moder)
   (setq *error* olderr)
   (close f)
   (command "text" "s" cst ^c)
   (redraw)
   (princ)
)

(defun C:et (/ olds oldss olds1 stp h txt wf st x0 y0 l n yes
                TXTA TXT1 NN AR AD CL cst)
   (setq olderr *error*
         *error* myerror)
   (setvar "BLIPMODE" 1)
   (setvar "CMDECHO" 0)
   (SETQ CL (GETVAR "CLAYER"))
   (setq cst (getvar "textstyle"))
   (setq olds (entsel "\nSelect the string :"))
   (SETQ OLDSS (CAR OLDS))
   (setq olds (entget  (car  olds)))
   (setq olds1 (cdr (assoc 0 olds)))
   (if (= "TEXT" oldS1)
       ( progn
          (COMMAND "ERASE" (SSADD OLDSS) "")
          (COMMAND "LAYER" "S"  (CDR (ASSOC 8 OLDS)) "")
          (setq stp  (trans (cdr (assoc 10 olds)) 0 1))
          (setq h   (cdr (assoc 40 olds)))
          (setq aR (cdr (assoc 50 olds)))
          (setq aD  (RTD (cdr (assoc 50 olds))))
          (setq txt (cdr (assoc 1 olds)))
          (setq wf (Cdr (assoc 41 olds)))
          (SETQ ST (CDR (ASSOC 7 OLDS)))
          (SETQ X0 (CAR STP) Y0 (CADR STP))
          (setq l (strlen txt))
          (setq n 1) (setq nn 2)
          (setq yes 1)
          (while (<= N L)
                  (setq tXT1 (substr txt n 2))
                  (SETQ TXTA (ASCII TXT1))
                  (setq nn (cond
                            ((= TXT1 "%%") 3)
                            ((> Txta 160) 2)
                            ((< Txta 129) 1)
                           )
                  )
                  (setq txt1 (substr txt n nn))
                  (setq n (+ n nn))
                  (command "text" "S" ST stp h aD txt1)
                  (IF (= NN 2)
                      (PROGN
                         (SETQ X0 (+ X0 (* (cos aR)  H WF 1.0625)))
                         (SETQ y0 (+ Y0 (* (sin aR)  H WF 1.0625)))
                      )
                      (PROGN
                         (SETQ JF (COND
                                     ((= TXTA 49) 0.65)
                                     ((= TXTA 46) 0.3)
                                     (T 1)
                                  )
                          )
                         (setq wf1 (* JF WF))
                         (SETQ X0 (+ X0 (* (cos aR)  H WF1)))
                         (SETQ y0 (+ Y0 (* (sin aR)  H WF1)))
                      )
                   )
                  (SETQ STP (LIST X0 Y0))
         )
     )
  )
(COMMAND "LAYER" "S" CL "")
  (command "text" "s" cst ^c)
(setq *error* olderr)
(princ)
)
;Setup environment
(DEFUN C:ENVIRON () (LOAD "ENVIRON")(C:ENVIRON))

;For clean memery
(defun C:CLEAN () (SETQ ATOMLIST (MEMBER 'C:CLEAN ATOMLIST)))
;
(princ)
(defun C:ct(/ w ctxth ntxth e ed)
   (setq w (ssget))
   (setq ctxth (getvar "TEXTSIZE"))
   (initget 6)
   (setq ntxth (getreal (strcat "\nNew texth eight<"
                                (rtos ctxth 2 2)
                                                ">: "))
   )
   (if (null ntxth) (setq ntxth ctxth))
   (setq i 0)
   (if w
     (while (< i (sslength w))
            (setq e (ssname w i))
      (if (= "TEXT" (cdr (assoc 0 (setq ed (entget e)))))
         (progn (setq ed (subst (cons 40 ntxth)
                                (assoc 40 ed) ed))
                (entmod ed)
       )
        )
      (setq i (1+ i))
    ); end while
); end if
)
(defun c:ppp (/ sset ent1 pt1 pt2 ang pt1_1 pt2_2 ent)
(setq sset (ssget))
(setq ent  (ssname sset 0))
(setq ent1 (entget ent))
(setq pt1 (cdr (assoc 10 ent1)))
(setq pt2 (cdr (assoc 11 ent1)))
(setq ang (angle pt1 pt2))
(setvar "osmode" 0)
(setq pt1_1 (polar pt2 ang 30))
(setq pt2_2 (polar pt1 (+ ang pi) 30))
(command "pline" pt1_1 "width" "60" "60" pt2_2 "")
(command "erase" sset "")
(setvar "osmode" 32)
)
(defun c:cs (/ txt new v1 v2)
(setvar "cmdecho" 0)
          (prompt "\nPick text to be changed:")
          (setq v1 (ssget))
          (setq newst (getstring T "\nenter new style:"))
          (setq newst (cons 7 newst))
          (setq v2 0)
              (if (/= v1 nil)
                  (while (< v2 (sslength v1))
                         (setq nme (ssname v1 v2))
                         (setq oldst (assoc 7 (entget nme)))
                         (setq v3 (entget nme))
                         (entmod (subst newst oldst v3))
                         (entupd nme)
                         (setq v2 (+ v2 1))
                   )
              )
  )
(defun c:SA () (command "osnap" "mid,int,end"))
(defun c:ee () (command "osnap" "endpoint"))
(defun c:ii () (command "osnap" "int"))
(defun c:mm () (command "osnap" "mid"))
(defun c:ae  () (command "osnap" "nea"))
(defun c:nn  () (command "osnap" "none"))
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)
(load"acadiso")
(princ)

wwxx

感谢分享