[编程交流] 视口错误（&R）

 
;**************************************************************
; routine to place proposed spot elevations w/user entered elev
; places text labels above leader
; version 1.1 ~ Oct 2008 ~ TJ Frazier
;**************************************************************
(defun c:pspot3 (/ spotloc E N Z BC scale loop lead1 lead2 elevstrtop elevstrbot *error*
 top height tempang1 tempang2 tempang3 tclabel bclabel oldtext)
; function to convert radians to degrees
(defun r2d (tempang)
 (* 180.0 (/ tempang pi))
); end r2d
; error handling function
(defun *error*(msg)
 (setvar "osmode" oldosnap)
 (setvar "cmdecho" oldcmdecho)
 (setvar "dimasz" olddimasz)
 (princ "\nConsole break or Error. Exit... ")
 (princ)
); end *error*
 (setq oldcmdecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq olddimasz (getvar "dimasz"))
 (setvar "dimasz" 0.0)
 (setq oldosnap (getvar "osmode"))
 (setq oldlayer (getvar "clayer"))
 (setq oldtext (getvar "textstyle"))
 (setq scale (getvar "dimscale"))
 
 (command "-layer" "m" "P Spot" "c" "7" "" "L" "" "" "") ; set current layer & color
 (command "-text" "s" "PSpot" "" "" "") ; set current text style
 
 (setq elevstrtop "6")
 
 (while (setq spotloc (getpoint "\nPick location for spot: ")) ; until "enter" get location for spot
   (setq E (car spotloc))
   (setq N (cadr spotloc))     
   (progn
      (setq lead1 (getpoint spotloc "\nPick label location: "))
      (setq lead2 (getpoint lead1 "\nPick label angle: "))
      (setq tempang1 (angle lead1 lead2))
      (setq tempang2 (- tempang1 1.5708))
      (setq tempang3 (+ tempang1 1.5708))
      (command "pline" spotloc lead1 lead2 "")
       
      (initget "Yes No")
      (setq top (getkword "\nLabeling curb elevs <Yes>/No? "))
      (and (not top)
        (setq top "Yes"))
      
      (if (= top "Yes") ; if spot is top also draw bottom
        (progn
   (setq Z (getreal "\nEnter top elevation: ")) ; get top elev
          (setq elevstrtop (rtos Z 2 2))
          (setvar "osmode" 0)
          (command "-insert" "spt9" (list E N Z) (* scale 0.1) "" "") ; insert block at top elev
          (setq height (getreal "\nHeight of curb (inches)? "))
   (setq BC (- Z (* height 0.0833)))
          (setq elevstrbot (rtos BC 2 2))
   (command "-insert" "spt9" (list E N BC) (* scale 0.1) "" "") ; insert block at bottom elev
   
          (if (> (car lead2) (car lead1))
     (progn
       (command "text" "j" "br" lead2 (* scale 0.1) (r2d tempang1) (strcat "TC" elevstrtop))
              (setq tclabel (entlast))
       (command "text" "j" "tr" lead2 (* scale 0.1) (r2d tempang1) (strcat "BC" elevstrbot))
              (setq bclabel (entlast)) 
       (command "move" tclabel bclabel "" lead2 (polar lead2 tempang3 (/ (sqrt scale) 2)))
     ) ; end progn
     (progn
       (command "text" "j" "bl" lead2 (* scale 0.1) (+ 180.0 (r2d tempang1)) (strcat "TC" elevstrtop))
              (setq tclabel (entlast))
       (command "text" "j" "tl" lead2 (* scale 0.1) (+ 180.0 (r2d tempang1)) (strcat "BC" elevstrbot))
       (setq bclabel (entlast))
       (command "move" tclabel bclabel "" lead2 (polar lead2 tempang2 2))
     ) ; end progn
          ) ;end if
        ) ; end progn
        (progn
   (setq Z (getreal "\nEnter elevation: ")) ; get elev
   (setq elevstrtop (rtos Z 2 2))
   (setvar "osmode" 0)
   (command "-insert" "spt9" (list E N Z) (* scale 0.1) "" "") ; insert block at elevation
          (if (> (car lead2) (car lead1))
     (command "text" "j" "br" lead2 (* scale 0.1) (r2d tempang1) elevstrtop)
     (command "text" "j" "bl" lead2 (* scale 0.1) (+ 180.0 (r2d tempang1)) elevstrtop)
   ) ; end if
 ) ; end progn
      ) ; end if
      
      (setvar "osmode" oldosnap)
   );end progn
 );end while
 (setvar "cmdecho" oldcmdecho)
 (setvar "dimasz" olddimasz)
 (setvar "clayer" oldlayer)
 (setvar "textstyle" oldtext)
 (princ)
)

 
         Viewport is view-locked. Switching to Paper space.
         Switching back to Model space.

 
         (PROGN
           (PRINC "\nSelect objects: ")
           (PRINC)
           (SETVAR "nomutt" 1)
           (SETQ mltss (SSGET
                         (LIST (CONS -4 "<OR")
                               (CONS 0 "TEXT")
                               (CONS 0 "MTEXT")
                               (CONS -4 "OR>")
                         ) ;_ end of LIST
                       ) ;_ end of SSGET
           ) ;_ end of SETQ
           (SETVAR "nomutt" 0)
         ) ;_ end of PROGN