[求助]：这个LISP可以在14运行不能在2000运行

cjk

这个LISP可以在14运行不能在2000运行

(defun swpick(/ dcl ph pk)(getsz "sw")
  (setq ph 0)(setq dcl(load_dialog "sw.dcl"))
  (if(not(new_dialog "sw" dcl))(exit))
  (setq swl '("ssh" "ssht" "sw" "swt" "tap" "tapt"))
  (mapcar 'show_slide swl)(sws)(foreach sw swl(action_tile sw "(if typ (mode_tile typ 4))
  (setq typ $key) (mode_tile typ 4)"))
  (action_tile "metric" "(sws)")
  (action_tile "unc" "(sws)")
  (action_tile "swlist" "(setq pk (atoi $value))
  (setq sz (nth pk tl))")
  (action_tile "hidden" "(setq ph (atoi $value))")
  (action_tile "accept" "(dlgchk)")(action_tile "cancel" "(done_dialog) (exit)")
  (start_dialog)(unload_dialog dcl))
(defun swset(sz / szl)(getsz "sw")
  (if(member sz ms)(setq szl(assoc sz msz))
    (setq szl(assoc sz dsz)))(mapcar 'set '(dt md md1 dd d d1 b s mtl) szl)
  (setq p(/(- md dd) 2.0) th(*(getvar "dimscale")(getvar "dimtxt"))))
(defun sws()(if(=(get_tile "unc") "1")(setq tl ds)(setq tl ms))
  (start_list "swlist")(mapcar 'add_list tl)(end_list))
(defun C:SW(/ typ pt pp la ss ls en)
  (defun *err*(msg)
    (setq *error* oerr oerr nil)
    (foreach x '(ms msz ds dsz pt pp la sl dt md md1 dd d d1 b s mtl p th)
      (set x nil))(princ))
  (setq oerr *error* *error* *err*)(swpick)
  (while T(if(member typ '("ssh" "sw" "tap"))
            (progn(setq pt(getpoint "\n 起点:") pp(getpoint pt "\n 终点:"))
              (cond((= typ "ssh")(ssh sz pt pp la))((= typ "sw")(sw sz pt pp la))
                   ((= typ "tap")(tap sz pt pp la))))
            (progn(setq pt(getpoint "\n 插入点或<Enter>取代旧圆:"))
              (if pt(cond((= typ "ssht")(ssht sz pt la))((= typ "swt")(swt sz pt la))
                         ((= typ "tapt")(tapt sz pt la)))
                (progn(prompt(strcat "\n 选取旧圆 <" sz ">:"))
                  (setq ss(ssget) ls(sslength ss))
                  (repeat ls(setq ls(1- ls))
                    (setq en(ssname ss ls))
                    (setq pt(trans(cdr(assoc 10(entget en))) 0 1))
                    (entdel en)(cond((= typ "ssht")(ssht sz pt la))
                                    ((= typ "swt")(swt sz pt la))
                                    ((= typ "tapt")(tapt sz pt la)))(entdel(entlast)))))))))
(defun SSH(sz pt pp la / ag pag mag pe pm pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8)
  (swset sz)(setq tl(-(+(distance pt pp)(* 1.5 md)) md1))(if(> tl mtl)(setq tl mtl))
  (setq ag(angle pt pp) pag(+ ag(/ pi 2.0))
        mag(- ag(/ pi 2.0)) pe(polar pp ag(* 1.5 md))
        pm(polar pe(+ ag pi) tl) pt1(polar pt pag(/ d1 2.0)) pt2(polar pm pag(/ d1 2.0))
        pt3(polar pt2 mag d1) pt4(polar pt1 mag d1) pt5(polar pm pag(/ md1 2.0))
        pt6(polar pp pag(/ md1 2.0)) pt7(polar pt5 mag md1) pt8(polar pt6 mag md1))
  (var)(command "clayer" "cen" "line" pt pp "" "clayer" la "pline" pt1 pt2 pt3 pt4 "" "line" pt5 pt6 "" "line" pt7 pt8 "")
  (if(< ag pi)(command "clayer" "text" "text" "j" "ml" pm th(rtd ag) dt)
    (command "clayer" "text" "text" "j" "mr" pm th(rtd(- ag pi)) dt))(rvar))
(defun ssht(sz pt la)(swset sz)(setq pt(trans pt 1 0))
  (var)(command "ucs" "w")(entmake(list '(0 . "BLOCK") '(2 . "*U") '(70 . 1)(cons 10 pt)))
  (cenl pt d1)(circle la pt d1)(circle "PART" pt md1)(setq bn(entmake(list '(0 . "ENDBLK"))))
  (entmake(list '(0 . "INSERT")(cons 8 la)(cons 2 bn)(cons 10 pt)))(text pt th dt)(command "ucs" "p")(rvar))
(defun SW(sz pt pp la / ag pag mag pe pm pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 p21 p22 p23 p24 p25)(swset sz)
  (setq tl(-(+(distance pt pp)(* 1.5 md)) md1))
  (if(> tl mtl)
    (setq tl mtl))
  (setq ag(angle pt pp) pag(+ ag(/ pi 2.0)) mag(- ag(/ pi 2.0))
        pe(polar pp ag(* 1.5 md)) pm(polar pe(+ ag pi) tl) pt1(polar pt pag(/ d1 2.0))
        pt2(polar pm pag(/ d1 2.0)) pt3(polar pt2 mag d1) pt4(polar pt1 mag d1)
        pt5(polar pm pag(/ md1 2.0)) pt6(polar pp pag(/ md1 2.0))
        pt7(polar pt5 mag md1) pt8(polar pt6 mag md1) p0(polar pm(+ ag pi) md)
        p1(polar p0 pag(-(/ d 2.0) p)) p2(polar p1(+ ag(/ pi 4))(* 1.414 p)) p3(polar p2 mag d)
        p4(polar p1 mag(- d(* p 2.0))) p5(polar p2 ag(- md p)) p6(polar p5 mag d)
        p7(polar pm pag(/ md 2.0)) pe1(polar pe(+ ag pi)(/(- md dd) 2.0))
        p8(polar pe1 pag(/ md 2.0)) p9(polar p8 mag md) p10(polar p7 mag md)
        p11(polar pe pag(/ dd 2.0)) p12(polar p11 mag dd) p13(polar p11 ag(* 0.5 md))
        p14(polar p13 mag dd) p15(polar p13(- ag(/ pi 3.0))(/ dd(sqrt 3))))
  (if(> s tl)(setq p18 p7 p19(polar p7(- ag(/ pi 4.0))(* 1.414(/(- md dd) 2.0))))
    (setq p18(polar p8(+ ag pi) s) p19(polar p11(+ ag pi) s)))
  (setq p16(polar p18 ag(/(- md dd) 2.0)) p17(polar p16 mag md) p20(polar p18 mag md) p21(polar p19 mag dd)
        p22(polar p8 ag(* 0.25 md)) p23(polar p22 mag md) p24(polar p11 ag(* 0.25 md)) p25(polar p24 mag dd))
  (trim pt p15 md)(var)(command "clayer" "cen" "line" pt p15 "" "clayer" la "pline" pt1 pt2 pt3 pt4 "" "pline"
                                p2 p5 p6 p3 p2 p1 p4 p3 "" "pline" p7 p8 p9 p10 "" "line" pt5 pt6 "" "line"
                                pt7 pt8 "" "pline" p8 p11 p12 p9 "" "pline" p11 p13 p14 p12 "" "pline"
                                p13 p15 p14 "" "line" p16 p17 "")
  (if(= la "PART")(command "color"(cdr(assoc 62(tblsearch "layer" "dim")))))
  (command "pline" p18 p19 p11 "" "pline" p20 p21 p12 "" "pline" p8 p22 p23 p9 "" "pline"
           p22 p24 p25 p23 "" "color" "bylayer")
  (if(< tl 90)
    (if(>=(rem tl 5) 2.5)
      (setq lt(+(- tl(rem tl 5)) 5))
      (setq lt(- tl(rem tl 5))))
    (if(>=(rem tl 10) 5)
      (setq lt(+(- tl(rem tl 10)) 10))
      (setq lt(- tl(rem tl 10)))))
  (if(member sz ds)(setq dtxt(strcat dt "x"(rtos(/ lt 25.4) 4 4) "L"))
    (setq dtxt(strcat dt "x"(rtos lt) "L")))
  (if(< ag pi)(command "clayer" "text" "text" "j" "ml" pm th(rtd ag) dtxt)
    (command "clayer" "text" "text" "j" "mr" pm th(rtd(- ag pi)) dtxt))(rvar))
(defun swt(sz pt la)(swset sz)
  (setq pt(trans pt 1 0))
  (var)(command "ucs" "w")(entmake(list '(0 . "BLOCK") '(2 . "*U") '(70 . 1)(cons 10 pt)))
  (cenl pt d1)(polygon pt b)(circle la pt d1)(circle la pt d)(setq bn(entmake(list '(0 . "ENDBLK"))))
  (entmake(list '(0 . "INSERT")(cons 8 la)(cons 2 bn)(cons 10 pt)))(text pt th dt)(command "ucs" "p")
  (rvar))
(defun polygon(p b / r p1 p2 p3 p4 p5 p6)
  (setq r(/ b 1.732) p1(polar p(/ pi 6.0) r) p2(polar p(/ pi 2.0) r) p3(polar p(* pi 0.8333) r)
        p4(polar p(* pi 1.1666) r) p5(polar p(-(/ pi 2.0)) r) p6(polar p(-(/ pi 6.0)) r))
  (line la p1 p2)(line la p2 p3)(line la p3 p4)(line la p4 p5)(line la p5 p6)(line la p6 p1))
(defun TAP(sz pt pp la / p1 p2 p3 p4 p5 p6 p7 p8 p9 ptxt)(swset sz)
  (setq ag(angle pt pp) pag(+ ag(/ pi 2.0)) mag(- ag(/ pi 2.0)) p1(polar pt pag(/ md 2.0))
        p2(polar p1 mag md) p3(polar p1(- ag(/ pi 4))(* 1.414 p)) p4(polar p3 mag dd)
        p5(polar p1 ag(-(* 1.75 md) p)) p6(polar p5 mag md)
        p7(polar p5(- ag(/ pi 4))(* 1.414 p)) p8(polar p7 mag dd)
        p9(polar p3 ag(-(* 2.0 md) p)) p10(polar p9 mag dd)
        p11(polar p9(- ag(/ pi 3.0))(/ dd(sqrt 3))) ptxt(polar pt ag(/ md 2.0)))
  (trim pt p11 md)(var)(command "clayer" "cen" "line" pt p11 "" "clayer" la "pline"
                                p1 p3 p4 p2 "" "pline" p3 p9 p10 p4 "" "pline" p9 p11 p10 "")
  (if(= la "PART")
    (setvar "clayer" "dim"))
  (command "pline" p1 p5 p6 p2 "" "pline" p5 p7 p8 p6 "")
  (if(< ag pi)(command "clayer" "text" "text" "j" "ml" ptxt th(rtd ag) dt)
    (command "clayer" "text" "text" "j" "mr" ptxt th(rtd(- ag pi)) dt))(rvar))
(defun TAPT(sz pt la / bn)(swset sz)
  (setq pt(trans pt 1 0))(var)(command "ucs" "w")
  (entmake(list '(0 . "BLOCK") '(2 . "*U") '(70 . 1)(cons 10 pt)))
  (cenl pt md)(circle la pt dd)
  (if(= la "HIDDEN")(circle la pt md)
    (arc "DIM" pt(/ md 2.0)(* 1.5 pi) pi))
  (setq bn(entmake(list '(0 . "ENDBLK"))))
  (entmake(list '(0 . "INSERT")(cons 8 la)(cons 2 bn)(cons 10 pt)))
  (text pt th dt)(command "ucs" "p")(rvar))

carrot1983

至少少了getsz子函数
[php]
(defun swpick (/ dcl ph pk)
  (getsz "sw")
  (setq ph 0)
  (setq dcl (load_dialog "sw.dcl"))
  (if (not (new_dialog "sw" dcl))
    (exit)
  )
  (setq swl '("ssh" "ssht" "sw" "swt" "tap" "tapt"))
  (mapcar 'show_slide swl)
  (sws)
  (foreach sw swl
    (action_tile
      sw
      "(if typ (mode_tile typ 4))
(setq typ $key) (mode_tile typ 4)"
    )
  )
  (action_tile "metric" "(sws)")
  (action_tile "unc" "(sws)")
  (action_tile
    "swlist"
    "(setq pk (atoi $value))
(setq sz (nth pk tl))"
  )
  (action_tile "hidden" "(setq ph (atoi $value))")
  (action_tile "accept" "(dlgchk)")
  (action_tile "cancel" "(done_dialog) (exit)")
  (start_dialog)
  (unload_dialog dcl)
)
(defun swset (sz / szl)
  (getsz "sw")
  (if (member sz ms)
    (setq szl (assoc sz msz))
    (setq szl (assoc sz dsz))
  )
  (mapcar 'set '(dt md md1 dd d d1 b s mtl) szl)
  (setq        p  (/ (- md dd) 2.0)
        th (* (getvar "dimscale") (getvar "dimtxt"))
  )
)
(defun sws ()
  (if (= (get_tile "unc") "1")
    (setq tl ds)
    (setq tl ms)
  )
  (start_list "swlist")
  (mapcar 'add_list tl)
  (end_list)
)
(defun C:tt (/ typ pt pp la ss ls en)
  (defun *err* (msg)
    (setq *error* oerr
          oerr nil
    )
    (foreach x
             '(ms msz ds dsz pt pp la sl dt md md1 dd d d1 b s mtl p th)
      (set x nil)
    )
    (princ)
  )
  (setq        oerr *error*
        *error*        *err*
  )
  (swpick)
  (while T
    (if        (member typ '("ssh" "sw" "tap"))
      (progn (setq pt (getpoint "\n 起点:")
                   pp (getpoint pt "\n 终点:")
             )
             (cond ((= typ "ssh") (ssh sz pt pp la))
                   ((= typ "sw") (sw sz pt pp la))
                   ((= typ "tap") (tap sz pt pp la))
             )
      )
      (progn
        (setq pt (getpoint "\n 插入点或取代旧圆:"))
        (if pt
          (cond        ((= typ "ssht") (ssht sz pt la))
                ((= typ "swt") (swt sz pt la))
                ((= typ "tapt") (tapt sz pt la))
          )
          (progn (prompt (strcat "\n 选取旧圆 <" sz ">:"))
                 (setq ss (ssget)
                       ls (sslength ss)
                 )
                 (repeat ls
                   (setq ls (1- ls))
                   (setq en (ssname ss ls))
                   (setq pt (trans (cdr (assoc 10 (entget en))) 0 1))
                   (entdel en)
                   (cond ((= typ "ssht") (ssht sz pt la))
                         ((= typ "swt") (swt sz pt la))
                         ((= typ "tapt") (tapt sz pt la))
                   )
                   (entdel (entlast))
                 )
          )
        )
      )
    )
  )
)
(defun SSH (sz pt pp la        / ag pag mag pe        pm pt1 pt2 pt3 pt4 pt5 pt6 pt7
            pt8)
  (swset sz)
  (setq tl (- (+ (distance pt pp) (* 1.5 md)) md1))
  (if (> tl mtl)
    (setq tl mtl)
  )
  (setq        ag  (angle pt pp)
        pag (+ ag (/ pi 2.0))
        mag (- ag (/ pi 2.0))
        pe  (polar pp ag (* 1.5 md))
        pm  (polar pe (+ ag pi) tl)
        pt1 (polar pt pag (/ d1 2.0))
        pt2 (polar pm pag (/ d1 2.0))
        pt3 (polar pt2 mag d1)
        pt4 (polar pt1 mag d1)
        pt5 (polar pm pag (/ md1 2.0))
        pt6 (polar pp pag (/ md1 2.0))
        pt7 (polar pt5 mag md1)
        pt8 (polar pt6 mag md1)
  )
  (var)
  (command "clayer"         "cen"        "line" pt     pp     ""            "clayer"
           la          "pline"        pt1    pt2    pt3    pt4    ""
           "line" pt5         pt6        ""     "line" pt7    pt8    ""
          )
  (if (< ag pi)
    (command "clayer" "text" "text" "j" "ml" pm th (rtd ag) dt)
    (command "clayer"
             "text"
             "text"
             "j"
             "mr"
             pm
             th
             (rtd (- ag pi))
             dt
    )
  )
  (rvar)
)
(defun ssht (sz pt la)
  (swset sz)
  (setq pt (trans pt 1 0))
  (var)
  (command "ucs" "w")
  (entmake
    (list '(0 . "BLOCK") '(2 . "*U") '(70 . 1) (cons 10 pt))
  )
  (cenl pt d1)
  (circle la pt d1)
  (circle "PART" pt md1)
  (setq bn (entmake (list '(0 . "ENDBLK"))))
  (entmake
    (list '(0 . "INSERT") (cons 8 la) (cons 2 bn) (cons 10 pt))
  )
  (text pt th dt)
  (command "ucs" "p")
  (rvar)
)
(defun SW (sz        pt   pp          la   /    ag         pag  mag  pe        pm   pt1  pt2
           pt3        pt4  pt5  pt6  pt7  pt8         p0   p1   p2        p3   p4          p5
           p6        p7   p8          p9   p10  p11         p12  p13  p14        p15  p16  p17
           p18        p19  p20  p21  p22  p23         p24  p25
          )
  (swset sz)
  (setq tl (- (+ (distance pt pp) (* 1.5 md)) md1))
  (if (> tl mtl)
    (setq tl mtl)
  )
  (setq        ag  (angle pt pp)
        pag (+ ag (/ pi 2.0))
        mag (- ag (/ pi 2.0))
        pe  (polar pp ag (* 1.5 md))
        pm  (polar pe (+ ag pi) tl)
        pt1 (polar pt pag (/ d1 2.0))
        pt2 (polar pm pag (/ d1 2.0))
        pt3 (polar pt2 mag d1)
        pt4 (polar pt1 mag d1)
        pt5 (polar pm pag (/ md1 2.0))
        pt6 (polar pp pag (/ md1 2.0))
        pt7 (polar pt5 mag md1)
        pt8 (polar pt6 mag md1)
        p0  (polar pm (+ ag pi) md)
        p1  (polar p0 pag (- (/ d 2.0) p))
        p2  (polar p1 (+ ag (/ pi 4)) (* 1.414 p))
        p3  (polar p2 mag d)
        p4  (polar p1 mag (- d (* p 2.0)))
        p5  (polar p2 ag (- md p))
        p6  (polar p5 mag d)
        p7  (polar pm pag (/ md 2.0))
        pe1 (polar pe (+ ag pi) (/ (- md dd) 2.0))
        p8  (polar pe1 pag (/ md 2.0))
        p9  (polar p8 mag md)
        p10 (polar p7 mag md)
        p11 (polar pe pag (/ dd 2.0))
        p12 (polar p11 mag dd)
        p13 (polar p11 ag (* 0.5 md))
        p14 (polar p13 mag dd)
        p15 (polar p13 (- ag (/ pi 3.0)) (/ dd (sqrt 3)))
  )
  (if (> s tl)
    (setq p18 p7
          p19 (polar p7 (- ag (/ pi 4.0)) (* 1.414 (/ (- md dd) 2.0)))
    )
    (setq p18 (polar p8 (+ ag pi) s)
          p19 (polar p11 (+ ag pi) s)
    )
  )
  (setq        p16 (polar p18 ag (/ (- md dd) 2.0))
        p17 (polar p16 mag md)
        p20 (polar p18 mag md)
        p21 (polar p19 mag dd)
        p22 (polar p8 ag (* 0.25 md))
        p23 (polar p22 mag md)
        p24 (polar p11 ag (* 0.25 md))
        p25 (polar p24 mag dd)
  )
  (trim pt p15 md)
  (var)
  (command "clayer"         "cen"        "line" pt     p15    ""            "clayer"
           la          "pline"        pt1    pt2    pt3    pt4    ""
           "pline"         p2        p5     p6     p3     p2            p1
           p4          p3         ""        "pline"              p7     p8            p9
           p10          ""         "line"        pt5    pt6    ""     "line" pt7
           pt8          ""         "pline"       p8     p11    p12    p9
           ""          "pline"        p11    p13    p14    p12    ""
           "pline"         p13        p15    p14    ""     "line" p16
           p17          ""
          )
  (if (= la "PART")
    (command "color" (cdr (assoc 62 (tblsearch "layer" "dim"))))
  )
  (command "pline" p18           p19           p11           ""           "pline" p20
           p21           p12           ""           "pline" p8           p22           p23
           p9           ""           "pline" p22           p24           p25           p23
           ""           "color" "bylayer"
          )
  (if (< tl 90)
    (if        (>= (rem tl 5) 2.5)
      (setq lt (+ (- tl (rem tl 5)) 5))
      (setq lt (- tl (rem tl 5)))
    )
    (if        (>= (rem tl 10) 5)
      (setq lt (+ (- tl (rem tl 10)) 10))
      (setq lt (- tl (rem tl 10)))
    )
  )
  (if (member sz ds)
    (setq dtxt (strcat dt "x" (rtos (/ lt 25.4) 4 4) "L"))
    (setq dtxt (strcat dt "x" (rtos lt) "L"))
  )
  (if (< ag pi)
    (command "clayer"
             "text"
             "text"
             "j"
             "ml"
             pm
             th
             (rtd ag)
             dtxt
    )
    (command "clayer"
             "text"
             "text"
             "j"
             "mr"
             pm
             th
             (rtd (- ag pi))
             dtxt
    )
  )
  (rvar)
)
(defun swt (sz pt la)
  (swset sz)
  (setq pt (trans pt 1 0))
  (var)
  (command "ucs" "w")
  (entmake
    (list '(0 . "BLOCK") '(2 . "*U") '(70 . 1) (cons 10 pt))
  )
  (cenl pt d1)
  (polygon pt b)
  (circle la pt d1)
  (circle la pt d)
  (setq bn (entmake (list '(0 . "ENDBLK"))))
  (entmake
    (list '(0 . "INSERT") (cons 8 la) (cons 2 bn) (cons 10 pt))
  )
  (text pt th dt)
  (command "ucs" "p")
  (rvar)
)
(defun polygon (p b / r p1 p2 p3 p4 p5 p6)
  (setq        r  (/ b 1.732)
        p1 (polar p (/ pi 6.0) r)
        p2 (polar p (/ pi 2.0) r)
        p3 (polar p (* pi 0.8333) r)
        p4 (polar p (* pi 1.1666) r)
        p5 (polar p (- (/ pi 2.0)) r)
        p6 (polar p (- (/ pi 6.0)) r)
  )
  (line la p1 p2)
  (line la p2 p3)
  (line la p3 p4)
  (line la p4 p5)
  (line la p5 p6)
  (line la p6 p1)
)
(defun TAP (sz pt pp la / p1 p2 p3 p4 p5 p6 p7 p8 p9 ptxt)
  (swset sz)
  (setq        ag   (angle pt pp)
        pag  (+ ag (/ pi 2.0))
        mag  (- ag (/ pi 2.0))
        p1   (polar pt pag (/ md 2.0))
        p2   (polar p1 mag md)
        p3   (polar p1 (- ag (/ pi 4)) (* 1.414 p))
        p4   (polar p3 mag dd)
        p5   (polar p1 ag (- (* 1.75 md) p))
        p6   (polar p5 mag md)
        p7   (polar p5 (- ag (/ pi 4)) (* 1.414 p))
        p8   (polar p7 mag dd)
        p9   (polar p3 ag (- (* 2.0 md) p))
        p10  (polar p9 mag dd)
        p11  (polar p9 (- ag (/ pi 3.0)) (/ dd (sqrt 3)))
        ptxt (polar pt ag (/ md 2.0))
  )
  (trim pt p11 md)
  (var)
  (command "clayer"         "cen"        "line" pt     p11    ""            "clayer"
           la          "pline"        p1     p3     p4     p2            ""
           "pline"         p3        p9     p10    p4     ""            "pline"
           p9          p11         p10        ""
          )
  (if (= la "PART")
    (setvar "clayer" "dim")
  )
  (command "pline" p1 p5 p6 p2 "" "pline" p5 p7 p8 p6 "")
  (if (< ag pi)
    (command "clayer"
             "text"
             "text"
             "j"
             "ml"
             ptxt
             th
             (rtd ag)
             dt
    )
    (command "clayer"
             "text"
             "text"
             "j"
             "mr"
             ptxt
             th
             (rtd (- ag pi))
             dt
    )
  )
  (rvar)
)
(defun TAPT (sz pt la / bn)
  (swset sz)
  (setq pt (trans pt 1 0))
  (var)
  (command "ucs" "w")
  (entmake
    (list '(0 . "BLOCK") '(2 . "*U") '(70 . 1) (cons 10 pt))
  )
  (cenl pt md)
  (circle la pt dd)
  (if (= la "HIDDEN")
    (circle la pt md)
    (arc "DIM" pt (/ md 2.0) (* 1.5 pi) pi)
  )
  (setq bn (entmake (list '(0 . "ENDBLK"))))
  (entmake
    (list '(0 . "INSERT") (cons 8 la) (cons 2 bn) (cons 10 pt))
  )
  (text pt th dt)
  (command "ucs" "p")
  (rvar)
)
[/php]

cjk

这个getsz子函数在这里面但好象还少一些东西我自己在看看
谢谢大家。

(defun spcpick(/ dcl ph pk)(getsz "spc")(setq dcl(load_dialog "spc.dcl"))(if(not(new_dialog "spc" dcl))(exit))(spcs 0)(show_slide "spc")(show_slide "spct")(action_tile "spc" "(if typ (mode_tile typ 4)) (setq typ $key) (mode_tile typ 4)")(action_tile "spct" "(if typ (mode_tile typ 4)) (setq typ $key) (mode_tile typ 4)")(action_tile "spclist" "(setq pk (atoi $value)) (spcset)")(action_tile "hidden" "(setq ph (atoi $value))")(action_tile "std" "(spcs (atoi $value))")(action_tile "d" "(setq d  (atof $value))")(action_tile "h" "(setq h (atof $value))")(action_tile "sd" "(setq sd ($value))")(action_tile "accept" "(dlgchk)")(action_tile "cancel" "(done_dialog) (exit)")(start_dialog)(unload_dialog dcl))(defun spcs(std)(cond((= std 0)(setq s ms sl msz s1 0))((= std 1)(setq s ds sl dsz s1 1))((= std 2)(setq s hs sl hsz s1 2)))(start_list "spclist")(mapcar 'add_list s)(end_list))(defun spcset(/ sz)(setq sz(nth pk sl) d(nth 1 sz) h(nth 2 sz) sd(nth 3 sz))(set_tile "d"(rtos d))(set_tile "h"(rtos h))(set_tile "sd" sd)(getsz "sw")(cond((= s1 0)(setq szl(assoc sd msz)))((= s1 1)(setq szl(assoc sd dsz)))((= s1 2)(setq szl(assoc sd hsz))))(setq msz nil dsz nil hsz nil)(setq sd1(nth 4 szl) sh(nth 1 szl) p(- sh(nth 3 szl)) b(nth 6 szl)))(defun C:SPC(/ typ bp tp pt)(spcpick)(cond((= typ "spc")(setq bp(getpoint "\nFrom point:"))(setq ag(getangle bp "To point:"))(spc bp ag))((= typ "spct")(while(setq pt(getpoint "\nInsert point:"))(spct pt)))))(defun SPC(bp ag / pag mag l p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)(setq pag(+ ag(/ pi 2.0)) mag(- ag(/ pi 2.0)) p1(polar bp pag(/ D 2.0)) p2(polar p1 ag h) p3(polar p2 mag D) p4(polar p1 mag D) p5(polar p2 mag(/(- D sd1) 2.0)) p6(polar p5 ag(- sh p)) p7(polar p6 mag sd1) p8(polar p5 mag sd1) p9(polar p6(- ag(/ pi 4.0))(* 1.414 p)) p10(polar p9 mag(- sd1 p p)))(var)(command "clayer" "cen" "line" bp(polar bp ag(+ h sh)) "" "clayer" la "pline" p1 p2 p3 p4 "c" "pline" p6 p9 p10 p7 p8 p5 p6 p7 "" "clayer" "text" "text" "m"(polar bp ag(+ h(/ sh 2.0))) 3 0 sd)(rvar))(defun spct(pt)(setq pt(trans pt 1 0))(var)(command "ucs" "w")(entmake(list '(0 . "BLOCK") '(2 . "*U") '(70 . 1)(cons 10 pt)))(cenl pt d)(circle la pt d)(circle la pt sd1)(polygon pt b)(setq bn(entmake(list '(0 . "ENDBLK"))))(entmake(list '(0 . "INSERT")(cons 8 la)(cons 2 bn)(cons 10 pt)))(text pt 3 "SPC")(command "ucs" "p")(rvar))(defun polygon(p b / r p1 p2 p3 p4 p5 p6)(setq r(/ b 1.732) p1(polar p(/ pi 6.0) r) p2(polar p(/ pi 2.0) r) p3(polar p(* pi 0.8333) r) p4(polar p(* pi 1.1666) r) p5(polar p(-(/ pi 2.0)) r) p6(polar p(-(/ pi 6.0)) r))(line la p1 p2)(line la p2 p3)(line la p3 p4)(line la p4 p5)(line la p5 p6)(line la p6 p1)) d

zml84

在使用COMMAND函数调用CAD系统命令时,最好遵守以下规则:
http://zml84.blog.sohu.com/48787059.html

netchar

现在用LISP的人还有多少！AutoDesk推出了ARX作为其更强大的二次开发接口，那么Lisp我们还有吗？

carrot1983

lisp是让我从不会编程到接触到编程。享受编程的乐趣和痛苦。
人总是不知足的，我也想学ARX，可是能力有限啊！
还没有搞清楚
C#
C语言
VC  
.net
有什么样的联系和区别。。。。累啊！！没有受过正式训练。呵呵