[编程交流] 帮助使用维度 lisp 代码

(Defun C:TEST1 (/ txtstl txtsze stryn prfx sufx svr scl ht pt pti ptx pty
                   old oldpl nodpl ptyp pllst i n prin meta distmeta ptdist
                   angprin angmeta angtxt ptp alfa nlin xlin ylin dlin flg 
                   xreg yreg na xa ya)

;*************drawing set-up***************************

   (command "undo" "m")
   (setvar "unitmode" 0)
   (setvar "aunits" 2)
   (setvar "angbase" (/ pi 2))
   (setvar "angdir" 1)
   (setvar "auprec" 4)
   (setvar "lunits" 2)
   (setvar "luprec" 3)
   (setvar "dimzin" 0)
(setq svr(getvar "osmode"))
(setq txtstl(getvar "textstyle"))
(setq txtsze(getvar "textsize"))
(setvar "cmdecho" 0)
(setq flg 1)
(setvar "cmdecho" 0)
 (setq scl (getvar "useri1")) ; dont change this
 (setq ht(* 0.00175 scl))     ; dont change this

;------------------------------------------------------------

  (TEXTPAGE)

 (princ "\n")(princ "\n")(princ "\n")
(progn
           (initget "1 2")
           (setq
             l
              (cond
                ((getkword
                   "\n select:
                       1. option1. 
                       2. option2.
"
                 )
                )
                ("1")
              )
           )

(if (eq l "1")
      (command "-style" "diast" "wgsimpl.shx" "0" "1.2" "0" "N" "N" "N")
      (command "_layer" "_m" "dim" "_c" "93" "" "_lw" "0.30" "" "")
          )
       (if (eq l "2")
      (command "-style" "ktdiast" "wgsimpl.shx" "0" "1" "0" "N" "N" "N")
      (command "_layer" "_m" "KT-DIM" "_c" "191" "" "_lw" "0.30" "" "")
           )
       
)

;--------------------------------------------------------------------------------------------

:********BOUNDARY LINE**********

 (setvar "osmode" 0)
 (setq old(entsel "\n select lwpolyline: "))
 (setq oldpl(entget(car old)))
 (setq nodpl(cdr(assoc 90 oldpl)))
 (setq ptyp (cdr(assoc 70 oldpl)))
 (command "area" "e" old)
 (setq pllst '())
 (setq i 0)
 (setq n 0)
 (while (car(nth i oldpl))
        (if (= (car(nth i oldpl)) 10) 
               (progn
                     (setq pllst (append pllst (list (cdr(nth i oldpl)))))
                     (setq n(+ 1 n))
               );endprogn
        );endif
         (setq i (+ i 1))
 );endwhile
 (if (= ptyp 1)
   (progn
         (setq pllst (append pllst (list(nth 0 pllst))))
         (setq pllst (cdr pllst))
   );endprogn     
 );endif
; (main)
;);close defun
;(defun main()

;*******
 (setq alfa 193)
 (foreach n pllst (command n))
 (command "")
 (command "erase" pt "")
 (setq i 0 prin 0 meta 0)
 (while (car(nth i pllst))
  (setq prin (- i 1))
  (setq meta (+ i 1))
    (if (= i 0)
               (setq prin (- n 1))
    )
    (if (= i (- n 1))
               (setq meta 0)
    )
  (setq angprin (angle (nth i pllst) (nth prin pllst)))
  (setq angmeta (angle (nth i pllst) (nth meta pllst)))
  (setq distmeta (distance (nth i pllst) (nth meta pllst)))

;-------------------------------------------------------------------------------

  (setq ptdist (polar 
                     (polar (nth i pllst) angmeta (/ distmeta 2)) 
                     (+ angmeta (* (/ pi 2) flg)) (* 0.5 ht)))
  (setq angtxt(- 500 (/ (* 400 angmeta) (* 2 pi)))) 
  (if (> angtxt 400)
              (setq angtxt (- angtxt 400))
  )
  (if (> angtxt 200)
        (progn
              (setq ptdist (polar 
                                 (polar (nth i pllst) angmeta (/ distmeta 2)) 
                                 (+ angmeta (* (/ pi 2) flg)) (* 1.50 ht)))
              (setq angtxt (- angtxt 200))
        );endprogn
  )
  (command "text" "j" "c" 
                         ptdist ht 
                         angtxt
                         (rtos distmeta 2 2)
  )
    (setq i (+ i 1))
 );endwhile
 (if (= ptyp 0)
               (command "erase" "l" "")
 )

 (setvar "osmode" svr)
 (setvar "cmdecho" 1)
 (setvar "textstyle" txtstl)
 (setvar "textsize"  txtsze)

; layer 0

(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
 (princ)
);close defun