请帮个忙

arik

我有一个原来在R12下用的lisp小程序，现在想用在R14下，可是不能用。是什么原因?

mccad

arik

请问如何贴

mccad

arik

AutoCAD PROTECTED LISP file
aI鰣w沋扚浣$k?,x邿L氩k?R总諎y乸?奚鰛q吗弢宬鰩i峬縭您哸?b?O騹!*3z汣宮?B岘/~怤

mccad

arik

arik

wangyue

你好管理員,請問怎么才能將全是亂碼的文件解密

mccad

(defun cht_Main        (/             sset         opt             ssl
                 nsset             temp         unctr             ct_ver
                 sslen             style         hgt             rot
                 txt             ent         loc             loc1
                 just-idx    justp         justq             orthom
                 cht_ErrorHandler         cht_OrgError
                 cht_OrgCmdecho                 cht_OrgTexteval
                 cht_OrgHighlight
                )
  (setq ct_ver "2.00")
  (defun cht_ErrorHandler (s)
    (if        (/= s "Function cancelled")
      (if (= s "quit / exit abort")
        (princ)
        (princ (strcat "\n错误: " s))
      )
    )
    (eval (read U:E))
    (if        cht_OrgError
      (setq *error* cht_OrgError)
    )
    (if        temp
      (redraw temp 1)
    )
    (ai_undo_off)
    ;; restore undo state
    (if        cht_OrgCmdecho
      (setvar "cmdecho" cht_OrgCmdecho)
    )
    (if        cht_OrgTexteval
      (setvar "texteval" cht_OrgTexteval)
    )
    (if        cht_OrgHighlight
      (setvar "highlight" cht_OrgHighlight)
    )
    (princ)
  )
  (if *error*
    (setq cht_OrgError *error*
          *error*      cht_ErrorHandler
    )
    (setq *error* cht_ErrorHandler)
  )
  (setq        U:G "(command \"_.undo\" \"_group\")"
        U:E "(command \"_.undo\" \"_en\")"
  )
  (ai_undo_on)
  ;; enable undo
  (setq cht_OrgCmdecho (getvar "cmdecho"))
  (setq cht_OrgHighlight (getvar "highlight"))
  (setvar "cmdecho" 0)
  (princ (strcat "\n 改变文本, 版权号 "
                 ct_ver
                 ", 版权1997 。Autodesk, Inc."
         )
  )
  (prompt "\n选择要改变的注释.")
  (setq sset (ai_aselect))
  (if (null sset)
    (progn
      (princ "\n没有选择物体.")
      (exit)
    )
  )
  (setq        ssl   (sslength sset)
        nsset (ssadd)
  )
  (if (> ssl 25)
    (princ "\n 检验选择的物体...")
  )
  (while (> ssl 0)
    (setq temp (ssname sset (setq ssl (1- ssl))))
    (if        (or
          (= (cdr (assoc 0 (entget temp))) "TEXT")
          (= (cdr (assoc 0 (entget temp))) "ATTDEF")
          (= (cdr (assoc 0 (entget temp))) "MTEXT")
        )
      (ssadd temp nsset)
    )
  )
  (setq        ssl   (sslength nsset)
        sset  nsset
        unctr 0
  )
  (print ssl)
  (princ " 发现注释(nnotation objects found).")
  (setq opt T)
  (while (and opt (> ssl 0))
    (setq unctr (1+ unctr))
    (command "_.UNDO" "_GROUP")
    (initget
      "Location Justification Style Height Rotation Width Text Undo"
    )
    (setq opt (getkword
                "\n高H/对齐J/定位L/旋转R/类型S/文字T/回退U/宽W: "
              )
    )
    (if        opt
      (cond
        ((= opt "Undo")
         (cht_Undo)
        )
        ((= opt "Location")
         (cht_Location)
        )
        ((= opt "Justification")
         (cht_Justification)
        )
        ((= opt "Style")
         (cht_Property "Style" "新类型名" 7)
        )
        ((= opt "Height")
         (cht_Property "Height" "新高度" 40)
        )
        ((= opt "Rotation")
         (cht_Property "Rotation" "新的旋转角度" 50)
        )
        ((= opt "Width")
         (cht_Property "Width" "新宽度" 41)
        )
        ((= opt "Text")
         (cht_Text)
        )
      )
      (setq opt nil)
    )
    (command "_.UNDO" "_END")
  )
  (if cht_OrgError
    (setq *error* cht_OrgError)
  )
  (eval (read U:E))
  (ai_undo_off)
  ;; restore undo state
  (if cht_OrgTexteval
    (setvar "texteval" cht_OrgTexteval)
  )
  (if cht_OrgHighlight
    (setvar "highlight" cht_OrgHighlight)
  )
  (if cht_OrgCmdecho
    (setvar "cmdecho" cht_OrgCmdecho)
  )
  (princ)
)
(defun cht_Undo        ()
  (if (not nop)
    (dscprinc)
  )
  (if (> unctr 1)
    (progn
      (command "_.UNDO" "_END")
      (command "_.UNDO" "2")
      (setq unctr (- unctr 2))
    )
    (progn
      (princ "\n没有操作进行回退. ")
      (setq unctr (- unctr 1))
    )
  )
)
(defun cht_Location ()
  (if (not nop)
    (dscprinc)
  )
  (setq        sslen (sslength sset)
        style ""
        hgt   ""
        rot   ""
        txt   ""
  )
  (command "_.CHANGE" sset "" "")
  (while (> sslen 0)
    (setq ent (entget (ssname sset (setq sslen (1- sslen))))
          opt (list (cadr (assoc 11 ent))
                    (caddr (assoc 11 ent))
                    (cadddr (assoc 11 ent))
              )
    )
    (prompt "\n新的文字位置: ")
    (command pause)
    (if        (null loc)
      (setq loc opt)
    )
    (command style hgt rot txt)
  )
  (command)
)
(defun cht_Justification ()
  (if (not nop)
    (dscprinc)
  )
  (initget
    "TL TC TR ML MC MR BL BC BR Align Center Fit Left Middle Right ?"
  )
  (setq sslen (sslength sset))
  (setq        justp
         (getkword
           "\n 排列A/拟合F/中心C/左L/中M/右R/左上TL/左中TC/右上TR/左中ML/正中MC/右中MR/左下BL/中下BC/右下BR/<?>: "
         )
  )
  (cond
    ((= justp "Left")
     (setq justp 0
           justq 0
           just-idx 4
     )
    )
    ((= justp "Center")
     (setq justp 1
           justq 0
           just-idx 5
     )
    )
    ((= justp "Right")
     (setq justp 2
           justq 0
           just-idx 6
     )
    )
    ((= justp "Align")
     (setq justp 3
           justq 0
           just-idx 1
     )
    )
    ((= justp "Fit")
     (setq justp 5
           justq 0
           just-idx 1
     )
    )
    ((= justp "TL")
     (setq justp 0
           justq 3
           just-idx 1
     )
    )
    ((= justp "TC")
     (setq justp 1
           justq 3
           just-idx 2
     )
    )
    ((= justp "TR")
     (setq justp 2
           justq 3
           just-idx 3
     )
    )
    ((= justp "ML")
     (setq justp 0
           justq 2
           just-idx 4
     )
    )
    ((= justp "Middle")
     (setq justp 4
           justq 0
           just-idx 5
     )
    )
    ((= justp "MC")
     (setq justp 1
           justq 2
           just-idx 5
     )
    )
    ((= justp "MR")
     (setq justp 2
           justq 2
           just-idx 6
     )
    )
    ((= justp "BL")
     (setq justp 0
           justq 1
           just-idx 7
     )
    )
    ((= justp "BC")
     (setq justp 1
           justq 1
           just-idx 8
     )
    )
    ((= justp "BR")
     (setq justp 2
           justq 1
           just-idx 9
     )
    )
    ((= justp "?") (setq justp nil))
    (T (setq justp nil))
  )
  (if justp
    (progn
      ;; Process them...
      (while (> sslen 0)
        (setq ent (entget (ssname sset (setq sslen (1- sslen)))))
        (cond
          ((= (cdr (assoc 0 ent)) "MTEXT")
           (setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent))
          )
          ((= (cdr (assoc 0 ent)) "TEXT")
           (setq ent (subst (cons 72 justp) (assoc 72 ent) ent)
                 opt (trans (list (cadr (assoc 11 ent))
                                  (caddr (assoc 11 ent))
                                  (cadddr (assoc 11 ent))
                            )
                            (cdr (assoc -1 ent))
                            ;; from ECS
                            1
                     )
                     ;; to current UCS
           )
           (setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
           (cond
             ((or (= justp 3) (= justp 5))
              (prompt "\n新的文字对齐点(New text alignment points): ")
              (if (= (setq orthom (getvar "orthomode")) 1)
                (setvar "orthomode" 0)
              )
              (redraw (cdr (assoc -1 ent)) 3)
              (initget 1)
              (setq loc (getpoint))
              (initget 1)
              (setq loc1 (getpoint loc))
              (redraw (cdr (assoc -1 ent)) 1)
              (setvar "orthomode" orthom)
              (setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
              (setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
             )
             ((or (/= justp 0) (/= justq 0))
              (redraw (cdr (assoc -1 ent)) 3)
              (prompt "\n新的文字位置: ")
              (if (= (setq orthom (getvar "orthomode")) 1)
                (setvar "orthomode" 0)
              )
              (setq loc (getpoint opt))
              (setvar "orthomode" orthom)
              (redraw (cdr (assoc -1 ent)) 1)
              (if (null loc)
                (setq loc opt)
                (setq loc (trans loc 1 (cdr (assoc -1 ent))))
              )
              (setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
             )
           )
          )
        )
        (entmod ent)
      )
    )
    (progn
      ;; otherwise list options
      (textpage)
      (princ "\n      对齐位置设置:\n")
      (princ "\t  左上TL     中上TC      右上TR\n")
      (princ "\t  左中ML     正中MC      右中MR\n")
      (princ "\t  左下BL     中下BC      右下BR\n")
      (princ "\t  左Left     中Center    右Right\n")
      (princ "\t  对齐Align  中Middle    拟合Fit\n")
      (princ "\n回车继续: ")
      (grread)
      (princ
        "\r                                                            "
      )
      (graphscr)
    )
  )
  (command)
)
(defun cht_Text        (/ ans)
  (if (not nop)
    (dscprinc)
  )
  (setq sslen (sslength sset))
  (initget "Globally Individually Retype")
  (setq        ans
         (getkword
           "\n 发现并替换文字.  单个(Individually)/重复(Retype)/<全部(Globally)>:"
         )
  )
  (setq cht_OrgTexteval (getvar "texteval"))
  (setvar "texteval" 1)
  (cond
    ((= ans "Individually")
     (progn
       (initget "Yes No")
       (setq ans (getkword "\n在对话框中修改文字? <Yes>:"))
     )
     (while (> sslen 0)
       (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
       (setq ss (ssadd))
       (ssadd (ssname sset sslen) ss)
       (if (= ans "No")
         (cht_Edit ss)
         (command "_.DDEDIT" sn "")
       )
       (redraw sn 1)
     )
    )
    ((= ans "Retype")
     (while (> sslen 0)
       (setq ent (entget (ssname sset (setq sslen (1- sslen)))))
       (redraw (cdr (assoc -1 ent)) 3)
       (prompt (strcat "\nOld text: " (cdr (assoc 1 ent))))
       (setq nt (getstring T "\nNew text: "))
       (redraw (cdr (assoc -1 ent)) 1)
       (if (> (strlen nt) 0)
         (entmod (subst (cons 1 nt) (assoc 1 ent) ent))
       )
     )
    )
    (T
     (cht_Edit sset)
     ;; Change all
    )
  )
  (setvar "texteval" cht_OrgTexteval)
)
(defun C:CHGTEXT () (cht_Edit nil))
(defun cht_Edit        (objs        /      last_o tot_o  ent    o_str  n_str
                 st        s_temp n_slen o_slen si            chf           chm
                 cont        ans    class
                )
  (if (not nop)
    (dscprinc)
  )
  (if (null objs)
    (setq objs (ssget))
  )
  (setq chm 0)
  (if objs
    (progn
      ;; If any objects selected
      (if (= (type objs) 'ENAME)
        (progn
          (setq ent (entget objs))
          (princ (strcat "\n存在的字符串: " (cdr (assoc 1 ent))))
        )
        (if (= (sslength objs) 1)
          (progn
            (setq ent (entget (ssname objs 0)))
            (princ (strcat "\n存在的字符串: " (cdr (assoc 1 ent))))
          )
        )
      )
      (setq o_str (getstring "\n 匹配字符串  : " t))
      (setq o_slen (strlen o_str))
      (if (/= o_slen 0)
        (progn
          (setq n_str (getstring "\n 新字符串     : " t))
          (setq n_slen (strlen n_str))
          (setq        last_o 0
                tot_o  (if (= (type objs) 'ENAME)
                         1
                         (sslength objs)
                       )
          )
          (while (< last_o tot_o)
            (setq class
                   (cdr
                     (assoc 0 (setq ent (entget (ssname objs last_o))))
                   )
            )
            (if        (or (= "TEXT" class)
                    (= "MTEXT" class)
                )
              (progn
                (setq chf nil
                      si  1
                )
                (setq s_temp (cdr (assoc 1 ent)))
                (while (= o_slen
                          (strlen (setq st (substr s_temp si o_slen)))
                       )
                  (if (= st o_str)
                    (progn
                      (setq s_temp (strcat
                                     (if (> si 1)
                                       (substr s_temp 1 (1- si))
                                       ""
                                     )
                                     n_str
                                     (substr s_temp (+ si o_slen))
                                   )
                      )
                      (setq chf t)
                      ;; Found old string
                      (setq si (+ si n_slen))
                    )
                    (setq si (1+ si))
                  )
                )
                (if chf
                  (progn
                    ;; Substitute new string for old
                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                    (setq chm (1+ chm))
                  )
                )
              )
            )
            (setq last_o (1+ last_o))
          )
        )
      )
    )
  )
  (if (/= (type objs) 'ENAME)
    (if        (/= (sslength objs) 1)
      (princ
        (strcat (rtos chm 2 0) " 多行文字改变(text lines changed).")
      )
    )
  )
  (terpri)
)
(defun cht_Property (typ prmpt fld / temp ow nw        ent tw sty w hw        lw sslen
                     n sn ssl)
  (if (not nop)
    (dscprinc)
  )
  (if (= (sslength sset) 1)
    ;; Special case if there is only
    (cht_ProcessOne)
    (progn
      (cht_SetPrompt)
      (if (= nw "List")
        (cht_ProcessList)
        (if (= nw "Individual")
          (cht_ProcessIndividual)
          (if (= nw "Select")
            (cht_ProcessSelect)
            (progn
              (if (= typ "Rotation")
                (setq nw (* (/ nw 180.0) pi))
              )
              (if (= (type nw) 'STR)
                (if (not (tblsearch "style" nw))
                  (progn
                    (princ (strcat nw ": Style not found. "))
                  )
                  (cht_ProcessAll)
                )
                (cht_ProcessAll)
              )
            )
          )
        )
      )
    )
  )
)
(defun cht_ProcessAll (/ hl temp)
  (if (not nop)
    (dscprinc)
  )
  (setq sslen (sslength sset))
  (setq hl (getvar "highlight"))
  (setvar "highlight" 0)
  (while (> sslen 0)
    (setq temp (ssname sset (setq sslen (1- sslen))))
    (entmod (subst (cons fld nw)
                   (assoc fld (setq ent (entget temp)))
                   ent
            )
    )
  )
  (setvar "highlight" hl)
)
(defun cht_ProcessOne ()
  (if (not nop)
    (dscprinc)
  )
  (setq temp (ssname sset 0))
  (setq ow (cdr (assoc fld (entget temp))))
  (if (= opt "Rotation")
    (setq ow (/ (* ow 180.0) pi))
  )
  (redraw (cdr (assoc -1 (entget temp))) 3)
  (initget 0)
  (if (= opt "Style")
    (setq nw (getstring (strcat prmpt " <" ow ">: ")))
    (setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: ")))
  )
  (if (or (= nw "") (= nw nil))
    (setq nw ow)
  )
  (redraw (cdr (assoc -1 (entget temp))) 1)
  (if (= opt "Rotation")
    (setq nw (* (/ nw 180.0) pi))
  )
  (if (= opt "Style")
    (if        (null (tblsearch "style" nw))
      (princ (strcat nw ": Style not found. "))
      (entmod (subst (cons fld nw)
                     (assoc fld (setq ent (entget temp)))
                     ent
              )
      )
    )
    (entmod (subst (cons fld nw)
                   (assoc fld (setq ent (entget temp)))
                   ent
            )
    )
  )
)
(defun cht_SetPrompt ()
  (if (not nop)
    (dscprinc)
  )
  (if (= typ "Style")
    (progn
      (initget "Individual List New Select ")
      (setq nw
             (getkword
               (strcat "\n 单个Individual/列表List/选择类型Select style/<"
                       prmpt
                       " 对所有的文字"
                       ">: "
               )
             )
      )
      (if (or (= nw "") (= nw nil) (= nw "Enter"))
        (setq nw (getstring (strcat prmpt
                                    " 对所有的文字"
                                    ": "
                            )
                 )
        )
      )
    )
    (progn
      (initget "List Individual" 1)
      (setq nw (getreal        (strcat        "\n单个Individual/列表List/<"
                                prmpt
                                " 对所有的文字"
                                ">: "
                        )
               )
      )
    )
  )
)
(defun cht_ProcessList ()
  (if (not nop)
    (dscprinc)
  )
  (setq unctr (1- unctr))
  (setq sslen (sslength sset))
  (setq tw 0)
  (while (> sslen 0)
    (setq temp (ssname sset (setq sslen (1- sslen))))
    (if        (= typ "Style")
      (progn
        (if (= tw 0)
          (setq tw (list (cdr (assoc fld (entget temp)))))
          (progn
            (setq sty (cdr (assoc fld (entget temp))))
            (if        (not (member sty tw))
              (setq tw (append tw (list sty)))
            )
          )
        )
      )
      (progn
        (setq tw (+ tw (setq w (cdr (assoc fld (entget temp))))))
        (if (= (sslength sset) (1+ sslen))
          (setq        lw w
                hw w
          )
        )
        (if (< hw w)
          (setq hw w)
        )
        (if (> lw w)
          (setq lw w)
        )
      )
    )
  )
  (if (= typ "Rotation")
    (setq tw (* (/ tw pi) 180.0)
          lw (* (/ lw pi) 180.0)
          hw (* (/ hw pi) 180.0)
    )
  )
  (if (= typ "Style")
    (progn
      (princ (strcat "\n" typ "(s) -- "))
      (princ tw)
    )
    (princ (strcat "\n"
                   typ
                   " -- 最小Min: "
                   (rtos lw 2)
                   "\t 最大Max: "
                   (rtos hw 2)
                   "\t 中间Avg: "
                   (rtos (/ tw (sslength sset)) 2)
           )
    )
  )
)
(defun cht_ProcessIndividual ()
  (if (not nop)
    (dscprinc)
  )
  (setq sslen (sslength sset))
  (while (> sslen 0)
    (setq temp (ssname sset (setq sslen (1- sslen))))
    (setq ow (cdr (assoc fld (entget temp))))
    (if        (= typ "Rotation")
      (setq ow (/ (* ow 180.0) pi))
    )
    (initget 0)
    (redraw (cdr (assoc -1 (entget temp))) 3)
    (if        (= typ "Style")
      (progn
        (setq nw (getstring (strcat "\n" prmpt " <" ow ">: ")))
      )
      (progn
        (setq nw (getreal (strcat "\n" prmpt " <" (rtos ow 2) ">: ")))
      )
    )
    (if        (or (= nw "") (= nw nil))
      (setq nw ow)
    )
    (if        (= typ "Rotation")
      (setq nw (* (/ nw 180.0) pi))
    )
    (entmod (subst (cons fld nw)
                   (assoc fld (setq ent (entget temp)))
                   ent
            )
    )
    (redraw (cdr (assoc -1 (entget temp))) 1)
  )
)
(defun cht_ProcessSelect ()
  (if (not nop)
    (dscprinc)
  )
  (princ "\n 查找何种类型名?  <*>: ")
  (setq        sn    (xstrcase (getstring))
        n     -1
        nsset (ssadd)
        ssl   (1- (sslength sset))
  )
  (if (or (= sn "*") (null sn) (= sn ""))
    (setq nsset        sset
          sn        "*"
    )
    (while (and sn (< n ssl))
      (setq temp (ssname sset (setq n (1+ n))))
      (if (= (cdr (assoc 7 (entget temp))) sn)
        (ssadd temp nsset)
      )
    )
  )
  (princ (strcat "\n类型: " sn))
  (print (setq ssl (sslength nsset)))
  (princ "发现.")
)
(cond
  ((and ai_dcl (listp ai_dcl)))                ; it's already loaded.
  ((not (findfile "ai_utils.lsp"))        ; find it
   (ai_abort "CHT" nil)
  )
  ((eq "failed" (load "ai_utils" "failed")) ; load it
   (ai_abort "CHT" nil)
  )
)
(if (not (ai_acadapp))
  (ai_abort "CHT" nil)
)
(defun c:cht () (cht_Main))
(princ "\n\tCHT 命令调入.")
(princ)
(princ)