[编程交流] 使用图层名称和

;;;==========================[ MacAlign.lsp ]========================== 
;;; Author: Copyright© 2009 Lee McDonnell (Lee Mac)                     
;;;         (Contact @ CADTutor.net, The Swamp.org)                     
;;; Version:  1.0 June 13, 2009                                         
;;;           2.0 June 14, 2009                                         
;;;           3.0 June 16, 2009                                         
;;;           4.0 June 16, 2009                                         
;;;           5.0 July 22, 2009                                         
;;; Purpose: To Align Text to a Curve                                   
;;; Sub_Routines: getpoint_or_text.lsp by Charles Alan Butler (CAB)     
;;;                                                                     
;;; Additional Features:                                                
;;; Use +/- to Alter Text Offset                                        
;;; Use "P" to toggle perpendicularity                                  
;;;====================================================================
;;;  MODIFIED TO SET TEXT AS CURVE LAYER  ;;
(defun c:MacAlign (/ *error* doc spc tmp tStr ent cObj
                    tObj gr cPt pt cAng lAng tSze
                  
                   ; *Mac$Str*  }
                   ; *Mac$tOff* } Global Variables
                   ; *Mac$Per*  }
                  )
 (vl-load-com)
 ;; Error Handler
 (defun *error* (msg)
   (and tObj (not (vlax-erased-p tObj))
        (vla-delete tObj))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (redraw) (princ))
 ;; Check for Locked Current Layer
 (if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))
 ;; Get Space & Doc
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 ;; Set First-time Defaults
 
 (or *Mac$Str*  (setq *Mac$Str* "text"))  
 (or *Mac$Per*  (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$tOff* (setq *Mac$tOff* 1.))
 (or tSze (setq tSze (getvar "TEXTSIZE")))
     
     ;; Get Curve to Align
     
     (while
       (progn
         (setq ent (nentsel "\nSelect Curve: "))
         (cond ((and (vl-consp ent)
                     (vl-position
                       (cdr (assoc 0 (entget (car ent))))
                         '("LINE" "LWPOLYLINE" "POLYLINE" "ARC"
                           "SPLINE" "CIRCLE" "ELLIPSE" "XLINE")))
                (setq cObj (vlax-ename->vla-object (car ent)))
                nil) ; Exit Loop
               (t (princ "\nMissed, Try Again..."))))) ; Keep in Loop
   (setq tStr (vla-get-layer cObj))
     ;; Create Text Object
     
       (vla-put-alignment
         (if tObj tObj
           (setq tObj
             (vla-addText spc tStr
               (vlax-3D-point '(0 0 0)) tSze))) acAlignmentMiddleCenter)
     (setq msg (princ "\n<< Type [+] or [-] for offset, and [P]erpendicular >>"))
     ;; Place Text
           
     (while
       (progn
         (setq gr (grread t 15 0))
         (redraw)        
         (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
                (setq pt (vlax-curve-getClosestPointto cObj cPt))
                (if (and (< 0 (getvar "OSMODE") 16383)
                         (setq osPt (osnap pt (osLst (getvar "OSMODE")))))
                  (osMark osPt))
                (setq cAng (angle pt cPt)
                      lAng (+ cAng *Mac$Per*))
                ;; Correct Angle
                
                (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                       (setq lAng (- lAng pi)))
                      ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                       (setq lAng (+ lAng pi))))
                
                (vla-move tObj
                  (vla-get-TextAlignmentPoint tObj)
                    (vlax-3D-point
                      (polar pt cAng (* tSze *Mac$tOff*))))
                (vla-put-Rotation tObj lAng) t)
               ((eq 2 (car gr))
                (cond ((vl-position (cadr gr) '(43 61))
                       (setq *Mac$tOff*
                         (+ (/ 1 10.) *Mac$tOff*)))
                      ((eq (cadr gr) 45)
                       (setq *Mac$tOff*
                         (-  *Mac$tOff* (/ 1 10.))))
                      ((vl-position (cadr gr) '(80 112))
                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                      ((eq 6 (cadr gr))
                       (cond ((< 0 (getvar "OSMODE") 16384)
                              (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))
                              (princ (strcat "\n<Osnap off>" msg)))
                             (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))
                                (princ (strcat "\n<Osnap on>" msg)))) t)
                      ((vl-position (cadr gr) '(13 32)) nil)
                      (t)))
               ((eq 3 (car gr))
                (if (and (< 0 (getvar "OSMODE") 16383)
                         (setq osPt (osnap pt (osLst (getvar "OSMODE")))))
                  (progn
                    (osMark osPt)
                    (setq cAng (angle pt cPt)
                          lAng (+ cAng *Mac$Per*))
                  ;; Correct Angle
                
                    (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                           (setq lAng (- lAng pi)))
                          ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                           (setq lAng (+ lAng pi))))
                    
                    (vla-move tObj
                      (vla-get-TextAlignmentPoint tObj)
                        (vlax-3D-point
                          (polar ospt cAng (* tSze *Mac$tOff*))))
                    (vla-put-Rotation tObj lAng)))
                nil)
               
               ((eq 25 (car gr)) nil) (t))))
 (redraw) (princ))
(defun oSlst (os / str cnt)
 (setq str "" cnt 0)
 (if (< 0 os 16383)
   (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua"
                  "_int" "_ins" "_per" "_tan" "_nea"
                  "_non" "_app" "_ext" "_par")
     (if (not (zerop (logand (expt 2 cnt) os)))
       (setq str (strcat str mod (chr 44))))
     (setq cnt (1+ cnt))))
 (vl-string-right-trim (chr 44) str))
(defun osMark (pt / drft osSz osCol ratio bold glst i)
 (setq drft (vla-get-drafting
              (vla-get-preferences
                (vlax-get-acad-object)))
       osSz (vla-get-AutoSnapMarkerSize drft)
       oscol (vla-get-AutoSnapMarkerColor drft)
       ratio (/ (getvar "VIEWSIZE")
              (cadr (getvar "SCREENSIZE")))
       bold (mapcar
              (function
                (lambda (x)
                  (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0)
 (repeat 50
   (setq glst
     (cons
       (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i)))      
 (foreach x bold
    (grvecs (append (list oscol) glst (cdr glst) (list (car glst)))
            (list (list  x  0.0 0.0 (car pt))
                  (list 0.0  x  0.0 (cadr pt))
                  (list 0.0 0.0 1.0 0.0)
                  (list 0.0 0.0 0.0 1.0)))))
(vl-load-com)