Author Topic: looking for a lisp - text with mask  (Read 18804 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
looking for a lisp - text with mask
« Reply #30 on: July 22, 2005, 11:40:21 AM »
I though I posted this yesterday but must not have completed the POST before I jumped to
another site. So here it is again.
With this routine you need to pick the actual text in the dimension.

I think I found the original code: http://tinyurl.com/9t5d4
as there was a copy here http://tinyurl.com/b4lg8


The following is modified from the original

Code: [Select]
;; (2005) CAB added check for expresstools loaded & support for
;;  wipeout command change from ACAD2000

;;Modified By C Witt (2003)
;;
;;--------------------------Ma­skDimText---------------------­---------------
;;Command to place a WIPEOUT behind selected DIMENSION text (one entity)
;;© 2001 Herman Mayfarth
;;Tested with AutoCAD Release 16 (2K4)
;;Known limitations:
;;  1. This routine works by asking the user to select a nested MTEXT object,
;;     and uses that object's entity data to define the WIPEOUT boundary.
;;     If you have dimension text stacked over/under the dimension line,
;;     i.e. using the \X code, this routine will _not_ mask all the text,
;;     since the over/under text are separate MTEXT entities.
;;     (A better & more sophisticated way would be to walk through the
;;     DIMENSION block & determine the bounding box of all MTEXT objects in the
;;     block, but this is a Q & D 1st attempt)
;;  2. This lisp command is designed for R16 (2K4).
;;
;;  Feel free to modify to suit your own needs &/or whims.
;;----------------------------­------------------------------­--------------
;;global function
;;test function to see if acwipeout.arx is available
(defun wipeoutp ()
;;
;;===========================================================
;;  CAB 03/20/2005
    ;;  Check for ExpressTools
    (if (member "acetutil.arx" (arx))
(if (wcmatch (getvar "ACADVER") "*16*")
           (or (NOT (arxload "acwipeout")) (setq et T))
           (or (not(member "wipeout.arx" (arx)))(setq et T))
)
    )
  et
  ;;============================================================
);wipeoutp

(defun C:maskdim ( / cecho oldlyr ent flag outer
                         boxmtext
                         lwrect
                 )
;;local functions
;;;--------------------boxmtex­t-----------------------------­--------
;;;  Purpose: draws a lwpolyline rectangle to enclose an MTEXT entity
;;;  Parameter: entity name of MTEXT entity
;;;  External function: lwrect to draw the rectangle
;;;---------------------------­------------------------------­--------
(defun boxmtext (ename / mtxtnt p10 h ang1 delta d1 boxang boxdia
                         attach vec p1 p3 hor vert)
  (setq mtxtnt (entget ename)
        p10 (cdr (assoc 10 mtxtnt))
        h (cdr (assoc 40 mtxtnt))
        hor (cdr (assoc 42 mtxtnt))
        vert (cdr (assoc 43 mtxtnt))
        ang1 (cdr (assoc 50 mtxtnt))
        attach (cdr (assoc 71 mtxtnt))
        vec (getvar "UCSXDIR")
        ang1 (+ (atan (cadr vec) (car vec)) ang1)
        delta (* h 0.35);adjust as req'd
        d1 (+ hor (* 2 delta))
        boxang (atan (+ vert (* 2 delta)) d1)
        boxdia (* (/ 1 (cos boxang)) d1)
  );setq
  (cond ((= attach 1);top left
        (setq p1 (polar p10 (+ (/(* 3 pi) 2) ang1) (+ vert delta))))
        ((= attach 2);top center
        (setq p1
        (polar (polar p10 (+ pi ang1) (/ hor 2)) (+ (/(* 3 pi) 2) ang1) (+ vert delta))))
        ((= attach 3);top right
        (setq p1
        (polar (polar p10 (+ pi ang1) hor) (+ (/(* 3 pi) 2) ang1) (+ vert delta))))
        ((= attach 4);middle left
        (setq p1 (polar p10 (+ (/(* 3 pi) 2) ang1) (+ (/ vert 2) delta))))
        ((= attach 5);middle center
        (setq p1
        (polar (polar p10 (+ pi ang1) (/ hor 2)) (+ (/(* 3 pi) 2) ang1) (+ (/ vert 2) delta))))
        ((= attach 6);middle right
        (setq p1
        (polar (polar p10 (+ pi ang1) hor) (+ (/(* 3 pi) 2) ang1) (+ (/ vert 2) delta))))
        ((= attach 7) ;bottom left
        (setq p1 (polar p10 (+ (/(* 3 pi) 2) ang1) delta)))
        ((= attach 8);bottom center
        (setq p1
        (polar (polar p10 (+ pi ang1) (/ hor 2)) (+ (/(* 3 pi) 2) ang1) delta)))
        ((= attach 9);bottom right
        (setq p1
        (polar (polar p10 (+ pi ang1) hor) (+ (/(* 3 pi) 2) ang1) delta)))
  );cond
  (setq
        p1 (polar p1  (+ pi ang1) delta)
        p3 (polar p1 (+ boxang ang1) boxdia)
  );setq
  (lwrect p1 p3 ang1 (getvar "CLAYER") 256 (getvar "CELTYPE"))
);boxmtext
;;;-------------------------lw­rect--------------------------­----------
;;; Purpose: draws a lightweight polyline rectangle
;;; Params: p1,p3 - WCS points at opposite corners
;;;         rotate - rotation angle of selected axis in radians
;;;         layer, color, ltype what they say
;;; Returns: EAL of entity
(defun lwrect (p1 p3 rotate layer color ltype / d13 abox p2 p4 elist)
  (setq  d13 (distance p1 p3)
         abox (- (angle p1 p3) rotate)
         p2 (polar p1 rotate (* (cos abox) d13))
         p4 (polar p1 (+ rotate (/ pi 2)) (* (sin abox) d13))
  )
  (entmake (list '(0 . "LWPOLYLINE")
                 '(100 . "AcDbEntity")
                 '(100 . "AcDbPolyline")
                  (cons 6 ltype)
                  (cons 8 layer)
                  '(43 . 0)
                  (cons 62 color)
                  '(90 . 4)
                  (cons 10 p1)
                  (cons 10 p2)
                  (cons 10 p3)
                  (cons 10 p4)
                  '(70 . 1);closed pline - must follow G.C. 10s
            )
  )
);lwrect
;;Main program
;;if acwipeout.arx is available
  (if (wipeoutp)
;;proceed
  (progn
;;save sysvars
  (setq cecho (getvar "CMDECHO") oldlyr (getvar "CLAYER"))
;;start UNDO group
  (command "_.UNDO" "BEGIN")
  (setvar "CMDECHO" 1)
;;setup a layer for WIPEOUTs
  (command "_.LAYER" "M" "TEXT" "") ; CAB S to M
;;loop until an MTEXT entity in a DIMENSION is selected
  (setq flag T)
  (while flag
    (setq alist (nentsel "\nSelect Dimension Text to Mask: ")
          ent (car alist)
          outer (car(last alist))
    )
    (if (= "MTEXT" (cdr (assoc 0 (entget ent))))
      (setq flag nil)
    )
  );while
;;draw a LWPOLYLINE rectangle enclosing the MTEXT
  (boxmtext ent)
;;call command to draw the WIPEOUT using the preceding LWPOLYLINE
  ;; (command "_.wipeout" "" (entlast) "y")
  ;;  CAB  -----------------------------------------------------
  (if  (< (atof (getvar "acadver")) 16.0) ; nil = r2004 or later
    (command "_.wipeout" "n" (entlast) "y") ; < 2004
    (command "_.wipeout" "p" (entlast) "y") ; 2004+
  )
  ;;  CAB  -----------------------------------------------------
 
;;change WIPEOUT to color 255
  (command "chprop" (entlast) "" "c" "255" "")
;;now call draworder to bring the DIMENSION to the front
;;it would be nice if there is a better way, that doesn't force a regen
;;the only sure way I can think of is to delete the DIMENSION and remake it
  (command "_.draworder"  outer "" "front");causes a regen
;;restore sysvars & end UNDO group
  (setvar "CMDECHO" cecho)
  (setvar "CLAYER" oldlyr)
  (command "_.UNDO" "END")
  );progn
  (alert "Wipeouts Not Available.")
  );if
  (princ)
);C:MD
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
looking for a lisp - text with mask
« Reply #31 on: July 22, 2005, 12:29:33 PM »
cab is that post for me or tc because i am not looking to mask my dimension text or use wipeouts. i would like it to first determine what the entities are (dtext or mtext) then if it is dtext it would prompt the user to either convert to mtext  then mask it using the manner in the code not wipeout or just cancel. if it is mtext it would just mask it. i am reading through the tutorials now. i don't know the answer for tc i joined initially and can login to the learning center

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
looking for a lisp - text with mask
« Reply #32 on: July 22, 2005, 12:37:18 PM »
Quote from: Hangman
I am looking at creating a textmask lsp for masking dimensions because some of the users are exploding the dimension strings just to mask the text.  And I can't use the fillcolor in the dimension because it plots a black box.    To do, To do.   :?:


It was for Hangman. :roll:
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
looking for a lisp - text with mask
« Reply #33 on: July 22, 2005, 01:01:07 PM »
sigh...thread hijacker

Hangman

  • Guest
looking for a lisp - text with mask
« Reply #34 on: July 22, 2005, 01:24:31 PM »
ELOQUINTET sighed:
Quote
sigh...thread hijacker


Sorry, I was struggling with my thread and you have a very close topic to my own problem.  It was very unintentional, I promise.   :oops:

 :P   So what can I do for you :?:
I'd write your lisp but you'll have to give me about two weeks, I'm in the same boat ...  just learning this stuff.  

BTW,  Thanks CAB, I really appreciate your help.

tcdan

  • Guest
looking for a lisp - text with mask
« Reply #35 on: July 24, 2005, 12:40:49 AM »
Quote
i am reading through the tutorials now. i don't know the answer for tc i joined initially and can login to the learning center

I guess stig's going public with his 10 week email-based course. . . although I bet not without a little fee
http://www.smadsen.com/course.htm