[编程交流] 文字随旋转插入

(defun C:test2 (/)
 (setq #BoxP1# (getpoint "\nSpecify first corner point: ")
#BoxP2# (getcorner "\nSpecify other corner point: " #BoxP1#)
#BoxP3# (list (Car #BoxP2#) (cadr #BoxP1#) 0)
#BoxP4# (list (Car #BoxP1#) (cadr #BoxP2#) 0)
#BoxTextHeight# (/ (* (abs (- (car #BoxP2#) (car #BoxP1#))) 0.125) 0.875)
#TextLayer# (getvar "CLAYER")
#BoxWidth# (abs (- (car #BoxP2#) (car #BoxP1#)))
#textheight# (/ #BoxWidth# 30)
#TextDate# (rtos (getvar "CDATE") 2 4)
#TextDateParsed# (strcat (substr #TextDate# 5 2)"/"(substr #TextDate# 7 2)"/"(substr #TextDate# 3 2))        
#TextPt# (list (min (car #BoxP1#) (car #BoxP3#) (car #BoxP3#) (car #BoxP4#))
               (+ (max (cadr #BoxP1#) (cadr #BoxP2#) (cadr #BoxP3#) (cadr #BoxP4#)) (/ #textheight# 3))
               );end #TextPt#
#UserName# (getvar "LOGINNAME")
#UserInitials# (strcase (strcat (substr #UserName# 1 1)(substr #UserName# (+ 2 (vl-string-position (ascii ".") #UserName#)) 1)))[color="red"] ;This might fail for you since our office comps use "first.last" format.[/color]
);end setq
 (vl-cmdf "_.rectangle" #BoxP1# #BoxP2#)
 (vl-cmdf "_.line" #BoxP1# #BoxP2# "")
 (vl-cmdf "_.line" #BoxP3# #BoxP4# "")
 (entmake (list '(0 . "TEXT")
              (cons 10 (trans #TextPt# 1 0))
              (cons 40 #textheight#) 
              (cons 1 (strcat "OBSOLETE " #TextDateParsed# " -" #UserInitials#))
              '(50 . 0.0)
              '(7 . "Standard")
              '(71 . 0)
              '(72 . 0)
              '(73 . 0)
        ) ;_  end list
   ) ;_  end entmake  
 (princ)
 );end defun

(defun c:test3 ( / getuser p1 p2 p3 p4 q1 q3 th zv )
   (defun getuser ( s / p )
       (if (setq p (vl-string-position 46 s))
           (strcat (substr s 1 1) (substr s (+ p 2) 1))
           s
       )
   )
   
   (if (and (setq q1 (getpoint "\nSpecify 1st corner: "))
            (setq q3 ((if (zerop (getvar 'worlducs)) getpoint getcorner) q1 "\nSpecify 2nd corner: "))
       )
       (progn
           (setq p1 (mapcar 'min q1 q3)
                 p3 (mapcar 'max q1 q3)
                 p2 (list (car p3) (cadr p1) (caddr p1))
                 p4 (list (car p1) (cadr p3) (caddr p1))
                 th (/ (- (car p2) (car  p1)) 7.0)
                 zv (trans '(0 0 1) 1 0 t) ;; UCS extrusion vector
           )
           (entmake
               (append
                  '(   (000 . "LWPOLYLINE")
                       (100 . "AcDbEntity")
                       (100 . "AcDbPolyline")
                       (090 . 4)
                       (070 . 1)
                   )
                   (list (cons 038 (caddr (trans p1 1 zv))))
                   (mapcar '(lambda ( x ) (cons 10 (trans x 1 zv))) (list p1 p2 p3 p4))
                   (list (cons 210 zv))
               )
           )
           (entmake (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p3 1 0))))
           (entmake (list '(0 . "LINE") (cons 10 (trans p2 1 0)) (cons 11 (trans p4 1 0))))
           (entmake
               (list
                  '(0 . "TEXT")
                  '(7 . "Standard")
                   (cons 010 (trans (list (car p1) (+ (cadr p3) (/ th 3.0)) (caddr p1)) 1 zv))
                   (cons 040 th)
                   (cons 050 (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 zv t)))
                   (cons 001 (strcase (strcat "OBSOLETE " (menucmd "m=$(edtime,0,ddmonyy)") " - " (getuser (getvar 'loginname)))))
                   (cons 210 zv)
               )
           )
       )
   )
   (princ)
)