[编程交流] 边界创建Lisp-按Tex

(defun c:BNDTXT (/ pt)
 (while (setq pt (cdr (assoc 10 (entget (ssname(ssget "_+.:E:S" '((0 . "TEXT"))) 0)))))
   (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
 )
 (princ)
)

(defun c:BNDTXTMULTIPLE (/ pt)
(if (setq ss (ssget '((0 . "TEXT"))))
        (repeat (setq in (sslength ss))
                (setq pt (cdr (assoc 10 (entget (ssname ss (setq in (1- in)))))))
                (command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
        )
)
(princ)
)

;;; 2000+ version
;;; Tbox.lsp - Draws boxes around Text, Mtext, Attributes & Dimension Text.
;;; BY: TOM BEAUFORD
;;; tombu@leoncountyfl.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;========================================================================
(defun c:tbox (/ *ERROR* thisdrawing EnTyp ENT EnPt SubE SEnTyp Blk BOBJ
                 elist EOBJ ELA rot of ps AtPt ss tb of ll lr ul ur)
 (vl-load-com)
 (defun *ERROR* (err) ; define local handler
  (princ)
 );; "" is the same message you get when exiting an AutoCAD command.
 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 (setvar "cmdecho" 0)
 (setq ENT "Something")
 (while ENT
   (while(not(or(= EnTyp "ATTRIB")(= EnTyp "ATTDEF")(= EnTyp "TEXT")(= EnTyp "MTEXT")))
     (if(not(= EnTyp nil))(prompt "\nEntity Selected not an Attribute or Text"))
     (if(setq ENT (entsel "\nSelect Attribute or Text: "))
       (setq EnTyp (cdr (assoc 0 (entget (car ENT))))
             EnPt (cadr ENT)
             ENT (car ENT)        ; Entity name
             SubE (car (nentselp "" EnPt))                ; SubEntity
             SEnTyp (cdr (assoc 0 (entget SubE)))                ; SubEntity type
       ); setq
       (setq ENT nil EnTyp nil SEnTyp nil)
     ); if
     (cond
       ((= SEnTyp "ATTRIB")(setq ENT SubE EnTyp SEnTyp SubE nil SEnTyp nil))
       ((= EnTyp "DIMENSION")
         (progn
           (princ "\nEnTyp = Dimension.")
           (setq Blk ENT                ; Parent entity name
                 ENT SubE
                 BOBJ (vlax-ename->vla-object Blk)        ; Entity object
                 EnTyp SEnTyp
                 SubE nil
                 SEnTyp nil
           ); setq
         ); progn
       ); EnTyp = "DIMENSION"
       (ENT(princ "\nEnTyp is not a Dimension, Insert or Attribute."))
     ); cond
     (setq elist (entget ENT); Entity list
     )
     (setq EOBJ (vlax-ename->vla-object ENT)        ; Entity object
               ELA (getvar "clayer")        ; Object layer
     );;setq
;      (if Blk(vlax-dump-object (vlax-ename->vla-object Blk)))
;      (vlax-dump-object EOBJ)        ; List object properties
     (if(acet-layer-locked ELA)        ; If object layer's locked
       (progn
         (prompt(strcat "Current Layer "" ELA "" is Locked."))
         (setq EnTyp nil)        ; continue while loop
       )
     )
   );;while
 
   (setq rot (vlax-get-property EOBJ 'Rotation)
          of (vlax-get-property EOBJ 'Height)
          ps (vlax-safearray->list(vlax-variant-value (vlax-get-property EOBJ 'InsertionPoint)))
   )
   (vla-startundomark thisdrawing)
   (cond
     ((= EnTyp "MTEXT")
       (progn
         (if Blk (setq of (*(vlax-get-property BOBJ 'TextGap)2)))
         (setq AtPt (vlax-get-property EOBJ 'AttachmentPoint))
         (cond
           ((or(= 1 AtPt)(= 4 AtPt)(= 7 AtPt))(setq  ps (polar ps(+ rot PI)(/ of 2))))
           ((or(= 2 AtPt)(= 5 AtPt)(= 8 AtPt))
             (setq  ps (polar ps(+ rot PI)(/ (+ (cdr(assoc 42 elist))of) 2)))
           )
           ((or(= 3 AtPt)(= 6 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot PI)(+ (cdr(assoc 42 elist))(/ of 2))))
           )
         )
         (cond
           ((or(= 1 AtPt)(= 2 AtPt)(= 3 AtPt))(setq  ps (polar ps(+ rot(/ PI 2))(/ of 2))))
           ((or(= 4 AtPt)(= 5 AtPt)(= 6 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(/ (+ (cdr(assoc 43 elist))of) 2)))
           )
           ((or(= 7 AtPt)(= 8 AtPt)(= 9 AtPt))
             (setq  ps (polar ps(+ rot(/ PI 2))(+ (cdr(assoc 43 elist))(/ of 2))))
           )
         )
         (setq  lr (polar ps rot (+ (cdr(assoc 42 elist))of))
                ul (polar ps (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
                ur (polar lr (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
         )
         (vl-cmdf "pline" "non" ps "non" ul "non" ur "non" lr "c")        ;Drawn Box
       ); progn
     ); EnTyp = "MTEXT"
     ((or(= EnTyp "ATTRIB")(= EnTyp "TEXT"))
       (progn
         (if(= EnTyp "ATTRIB")
            (setq
              elist(subst(cons 73 (cdr(assoc 74 elist)))(assoc 74 elist)elist)
              elist(subst(cons 0 "TEXT")(assoc 0 elist)elist)
            )
         ); if
         (vl-cmdf "ucs" "OBject" ENT)
         (setq tb (textbox elist)
               ll (list(-(car(car tb))(/ of 6))(-(cadr(car tb))(/ of 6)))
               ur (list(+(car(cadr tb))(/ of 6))(+(cadr(cadr tb))(/ of 6)))
         )
         (vl-cmdf "rectang" "non" ll "non" ur)        ;Drawn Box
         (vl-cmdf "ucs" "p")
       ); progn
     ); EnTyp = "ATTRIB" or "TEXT"
   ); cond
   (setq Box (vlax-ename->vla-object (entlast)))
   (vl-catch-all-apply 'vla-put-Linetype (list Box "CONTINUOUS"))
   (vl-catch-all-apply 'vla-put-ConstantWidth (list Box (/ of 20)))
   (setq EnTyp nil SEnTyp nil)
   (vla-endundomark thisdrawing)
 ); while
 (princ)
); defun