Author Topic: toggles MTEXT Background Mask ON or OFF  (Read 2866 times)

0 Members and 1 Guest are viewing this topic.

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
toggles MTEXT Background Mask ON or OFF
« on: September 14, 2007, 11:27:14 AM »
It's been a while!

Code: [Select]
;;;
;;; Fri Sep 14, 2007
;;; simply toggles MTEXT Background Mask ON or OFF
;;; Mark S. Thomas ( mark< at >theswamp.org )
;;;

(defun MST-entsel-name ( msg objname / ent obj )
  ;;
  ;; returns a VLA-OBJECT if 'objname' matches ObjectName otherwise nil
  ;; traps any errors in the function
  ;; msg = string
  ;; objname = string
  ;; example: (setq CirObj (MST-entsel-name "\nSelect A Circle..." "AcDbCircle"))
  ;;
  (setq ent (vl-catch-all-apply 'entsel (list msg)))
  (if (and ent (not (vl-catch-all-error-p ent)))
    (progn
      (setq obj (vlax-ename->vla-object (car ent)))
      (if (/= (vla-get-ObjectName obj) objname)
(setq obj nil)
)
      )
    ); if
  obj
  ); defun

(defun ToggleBackgroundMask ( / obj ans )
  (if (setq obj (MST-entsel-name "\nSelect Mtext..." "AcDbMText"))
    (progn
      (setq ans (vlax-get-property obj 'BackgroundFill))
      (cond
((= ans :vlax-true)
(vlax-put-property obj 'BackgroundFill :vlax-false)
(princ "\nTurned Background Mask OFF")
)
((= ans :vlax-false)
(vlax-put-property obj 'BackgroundFill :vlax-true)
(princ "\nTurned Background Mask ON")
)
)
      )
    (alert "That wasn't Mtext!")
    )
  (princ)
  )

(defun c:tbm ()
  (princ "\nToggles Background Mask ON/OFF")
  (ToggleBackgroundMask)
  )
TheSwamp.org  (serving the CAD community since 2003)

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: toggles MTEXT Background Mask ON or OFF
« Reply #1 on: September 14, 2007, 11:31:41 AM »
Here is the one I use

Code: [Select]
;;; ------------------------------------------------------------------------
;;;    BMASK.lsp v1.0
;;;
;;;    Copyright © January, 2007
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;    WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;    PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;;    PROGRAMMER.
;;;
;;; -----------------------------------------------------------------------
(defun C:BM (/ *error* OldCmdEcho TextObj TextEntList vlText vlFill)

;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)

(if (not (member MSG '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
(princ "\n... Program Cancelled ...")
)
(while (< 0 (getvar "cmdactive"))
(command)
)
(setvar "CMDECHO" OldCmdEcho)
)

;; Set variables
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

;; Load vlisp
(vl-load-com)

;; Select object
(while(null(setq TextObj(car(entsel "\nSelect MTEXT: "))))
(princ " \nNothing Selected...Try Again ")
)

;; Get text entity list
(setq TextEntList (entget TextObj))

;; Check for MTEXT
(if (not (= (cdr (assoc 0 TextEntList)) "MTEXT"))
(progn
(alert "Selected entity is not MTEXT")
;; Reset variables
(setvar "CMDECHO" OldCmdEcho)
;; Restart the program
(C:BM)
)
)

;; Create activeX text
(setq vlText (vlax-ename->vla-object TextObj))

;; Check for background fill
(setq vlFill (vlax-get-property vlText 'backgroundfill))

;; If no background fill exsists
(if (= vlFill :vlax-false)
(progn
;; Set background fill for text
(vlax-put-property vlText 'backgroundfill :vlax-true)
(princ "\n Background fill applied")
)
(progn
;; Set background fill for text
(vlax-put-property vlText 'backgroundfill :vlax-false)
(princ "\n Background fill removed")
)
)

;; Set the draworder to bring text front
(command "draworder" TextObj "" "front")

;; Reset variables
(setvar "CMDECHO" OldCmdEcho)
(princ)
)
;;;
;;; Echos to the command line
(princ "\n BMask v1.0 ©Timothy Spangler, \n  January, 2007....loaded.")
(terpri)
(princ "C:BM")
(print)
;;; End echo
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

ronjonp

  • Needs a day job
  • Posts: 7529
Re: toggles MTEXT Background Mask ON or OFF
« Reply #2 on: September 14, 2007, 01:04:07 PM »
Here is mine:

Code: [Select]
(defun c:togmask (/ ss obj)
  (if (setq ss (ssget '((0 . "MTEXT"))))
    (mapcar '(lambda (x)
       (setq obj (vlax-ename->vla-object x))
       (if (= (vla-get-backgroundfill obj) :vlax-false)
(vla-put-backgroundfill obj :vlax-true)
(vla-put-backgroundfill obj :vlax-false)
       )
     )
    (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
  )
  (princ)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC