Jump to content

Resize Mtext box using Acet-Geom-textbox

gilsoto13

By gilsoto13
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

gilsoto13 Community Regular

gilsoto13

Posted
Posted (edited)

Hi, Everyone:

 

Hope someone likes this thread and comment.

I want to resize selected mtext to fit its text value (text content), in order to use it for a lisp routine made to apply a background color fill to selected text, mtext and dimensions. Right now, it applies the background fill excellent, it was revised by Alan, and its a grest piece of work, but I think it can be even better if you add this function.

 

I can see that textmask.lsp uses a subfunction called "Acet-Geom-Textbox" stored in "acetutil.fas" to get text value geometry to assign a textbox, I would like to use the same function in this routine, but to re-assign (modify) the textbox to selected mtext objects.

 

I found a reference lisp (made by Cadmoogle) that converts text objects to mtext using this express function to assing the text box to selected text objects, in case you might want to check it out.

http://forums.cadalyst.com/showthread.php?t=5800

(defun c:t3 (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
 (progn
  (princ "\nNo objects selected.")
  (exit)
 )
)
(setq count 0)
(while (/= (ssname sset COUNT) nil)
 (setq EN (ssname sset COUNT))
 (setq EL (entget EN))
 (if (= (cdr (assoc 0 EL)) "TEXT")
  (progn
   (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
   (setq bbox (acet-geom-textbox EL 0.1))
   (setq point1 (car bbox))
   (setq point2 (cadr bbox))
   (setq point3 (cadr (cdr bbox)))
   (setq point4 (cadr (cdr (cdr bbox))))
   (setq mwidth (cons '41 (distance point1 point2)))
   (setq mheight (cons '40 (cdr (assoc 40 el))))
   (setq mstyle (cons '7 (cdr (assoc 7 el))))
                               (setq mlayer (cons '8 (cdr (assoc 8 el))))
   (setq nspace (cons '410 (cdr (assoc 410 EL))))
   (setq minsert (cons '10 (cdr (assoc 10 EL))))
   (cond
    ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 
1)));JY
    ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 
2)));JU
    ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 
3)));JI
    ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 
6)));JK
    ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 
7)));JN
    ((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 
));JM
    ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 
9)));J,
    ((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 
7)));JN
   )
   (setq mrotate (cons '50 (cdr (assoc 50 el))))
   (setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace mlayer '(100 . 
"AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
   (entmake nmtext)
   (entdel en)
   (setq count (+ count 1))
  )
  (setq count (+ count 1))
 )
)
(setvar "cmdecho" 1)(princ)
)

 

And here is the routine where I want to add this function, I just started to sort this new issue, so I am clueless right now.. I'll keep looking for samples.

 

;;; ;BA.lsp  -BACKGROUND FILL ALL-
;;; ;Made for M3 Mexicana. December 2009
;;; ;This routine will set a background color fill to all selected text, 
;;; ;mtext and dimensions, it will update dimensions to current Dimstyle with 
;;; ;Dimtfill set to 1 temporarily for this purpose, so it works for current 
;;; ;Dimscale only, text objects will be converted to mtext with width=0
;;; ;It will bring objects in layer 'Dims' to front at the end
;;; ;Reviewed and modified by: Alan J. Thompson.
;;; ;December 2009
;;;
;;; ; Some part of code from Tom Beauford, from AUGI
;;; ;[url]http://forums.augi.com/showthread.php?t=77962[/url]
;;; ; Set 'Border Offset Factor' to 1.15
(vl-load-com)
(defun c:BA (/ *error* ttm2 ss elist sel1 sel3 dimt)
;;; error handler
 (defun *error* (#Message)
   (and dimt (setvar "dimtfill" dimt))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun
;;Using code from Roberto Gonzalez -robierzogg- from HISPACAD
;;[url]http://www.hispacad.com/foro/viewtopic.php?p=142823&sid=b23c3147d2a06a29d1dfd60078f79c08[/url]
;;;This routine works only if Express tools are installed
;;; Convert selected text into Mtext 
(command "undo" "begin")  ;beginning of undo group
 (defun ttm2 (name_n / collect n name_n insertpt name_n1 newlist)
   (setq insertpt (assoc 10 (entget name_n)))
;Convert Text to Mtext, using the EXPRESS command
   (command "txt2mtxt" name_n "")
;We set their original insertion point here
   (setq name_n1 (entlast))
   (SETQ newlist (SUBST insertpt (ASSOC 10 (ENTGET name_n1)) (ENTGET name_n1)))
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(71 . 7) (ASSOC 71 (ENTGET name_n1)) (ENTGET name_n1)))
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(46 . 0) (ASSOC 46 (ENTGET name_n1)) (ENTGET name_n1)))
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(41 . 0) (ASSOC 41 (ENTGET name_n1)) (ENTGET name_n1)))
   (ENTMOD newlist)
 ) ;_ defun
 (setq dimt (getvar "dimtfill"))
 (setvar "dimtfill" 1)
 (princ "\nSelect Dimensions and text to apply the background fill and update...: ")
 (and (setq ss (ssget "_:L" '((0 . "MTEXT,*DIMENSION*,TEXT"))))
      (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
        (cond
          ((eq "MTEXT" (cdr (assoc 0 (setq elist (entget x)))))
           (vla-put-backgroundfill (vlax-ename->vla-object x) :vlax-true)
           (setq elist [color=red](subst (cons 41 0.0) (assoc 41 elist) elist)[/color]
[color=red]                  elist (subst (cons 46 0.0) (assoc 46 elist) elist)[/color]
[color=black]                 elist (subst (cons 45 1.15) (assoc 45 elist) elist)[/color]
[color=black]                 elist (subst (cons 421 256) (assoc 421 elist) elist)[/color]
           ) ;_ setq
           (entmod elist)
          )
          ((eq "TEXT" (cdr (assoc 0 (entget x))))
           (ttm2 x)
           (ssdel x ss)
           (vla-put-backgroundfill (vlax-ename->vla-object (setq elist (entlast))) :vlax-true)
           (ssadd elist ss)
           (setq elist (entget elist))
           (setq elist (subst (cons 45 1.15) (assoc 45 elist) elist)
                 elist (subst (cons 421 256) (assoc 421 elist) elist)
           ) ;_ setq
           (entmod elist)
          )
          (T T)
        ) ;_ cond
      ) ;_ foreach
      (vl-cmdf "_.-dimstyle" "_apply" ss "")
      (vl-cmdf "_.draworder" ss "" "_f")
 ) ;_ and
 (if (setq sel5 (ssget "_X" '((0 . "INSERT")(2 . "CENTER LINE2,COLUMN ROW BUBBLE2,DETAIL BUBBLE 12,DETAIL BUBBLE2,DUST PICK UP POINT2,EQUIPMENT TAG2,FULL SECTION LR2,FULL SECTION UD2,FULL SECTION2,MATCH LINE SP2,MATCH LINE2,NORTH ARROW2,NOTE BOX2,NOTE ENCL2,PARTIAL SECTION T2,PARTIAL SECTION2,PLATE2,REVISION2,SAMPLE NUMBER2,SECTION CUT UD2,SECTION CUT2,STAMP BIG2,STAMP SMALL2,STREAM NUMBER2,STREAM SEQUENCE2,TAG2,TITLE 12,TITLE BUBBLE 12,TITLE BUBBLE2,TITLE2,WORK POINT2,ROOMTAG,ROOMTAG2,DOORTAG,WALLTAG,WINDOWTAG,MULTIPLE DETAIL,IND WALL CEIL 1, IND WALL UP 1, IND WALL L 1, IND WALL R 1, IND WALL DN 1"))))
   (vl-cmdf "_.draworder" sel5 "" "_f")
 ) ;_ if
 (if (setq sel4 (ssget "_X" '((0 . "line,lwpolyline,insert,polyline,arc,circle,spline,hatch,region"))))
   (vl-cmdf "_.draworder" sel4 "" "_b")
 ) ;_ if
 (if (setq sel1 (ssget "_X" '((0 . "leader,*Dimension*"))))
   (vl-cmdf "_.draworder" sel1 "" "_f")
 ) ;_ if
 (if (setq sel3
            (ssget "_X"
                   '((0 . "line,lwpolyline,polyline")
                     (8 . "Dims,Ar-Dims,G-Dims,M-Dims,E-Dims,S-Dims,P-Dims")
                    )
            ) ;_ ssget
     ) ;_ setq
   (vl-cmdf "_.draworder" sel3 "" "_f")
 ) ;_ if
 (setvar "dimtfill" dimt)
 (princ)
(command "undo" "end")  ;end of undo group
) ;_ defun
(princ
 "\Type \"BA\" to mask all text, mtext and dimensions at once."
)
(princ
 "\Remember to set dimscale according to selected dimensions before using it."
)

Edited by SLW210
Link to comment
Share on other sites
gilsoto13 Community Regular

gilsoto13

Posted
  • Author
Posted

I think I can start from here, found another coding attemp from Cadmoogle.

This one resizes selected mtext box to zero.

 

 
(defun c:setw (/ tmp ss lst EntData)
 (setq ss (ssget '((0 . "MTEXT"))))
 (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (mapcar '(lambda (x)
            (setq EntData (entget x))
     (setq tmp (subst (cons 46 0.0) (assoc 46 EntData) EntData))
            (entmod (subst (cons 41 0.0) (assoc 41 EntData) tmp))
          )
         lst
 )
 (command ".regen")
 (princ)
)

Link to comment
Share on other sites
LEsq Enthusiast

LEsq

Posted
Posted

The problem that you are going to hit... is that from Visual Lisp it is not exposed the MText Height property (the one available it is the height for the text objects).

 

Then you can only fix/update the Width (the one available for MText).

 

Your next options can be ObjectARX or .NET (C#).

Link to comment
Share on other sites
CAB Proficient

CAB

Posted
Posted

This might help.

;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;       +                  box_mtext                             +
;;;       +            Created by C. Alan Butler                   +
;;;       +               Copyright 2005                           +
;;;       +   by Precision Drafting & Design All Rights Reserved.  +
;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; 
;;; VERSION 
;;;  1.2 Jan 24, 2006  UCS corrections
;;; 
;;; FUNCTION 
;;;  Return Box coordinates for an Mtext object in any UCS, any angle. 
;;; 
;;; USAGE 
;;;  (box_mtext ent)
;;; 
;;; ARGUMENTS 
;;;  ent = mtext ename
;;; 
;;;  RETURNS
;;;   list of 4 points for box,  (ll lr ur ul)
;;; 
;;; PLATFORMS 
;;;  2000+ Tested in 2000 only
(defun box_mtext (ent / elst p10 txth ang vec wid hgt dxf UCSangle
                 attpt ul ur lr ll)
 (defun dxf (code elst)
   (cdr (assoc code elst))
 )

 ;; incase it is a list,  (ename point)
 (and (listp ent) (setq ent (car ent)))
 (setq elst (entget ent))

 (setq p10   (trans (dxf 10 elst) 0 1) ; insertion point WCS to UCS
       txth  (dxf 40 elst) ; text height
       wid   (dxf 42 elst) ; full width
       hgt   (dxf 43 elst) ; full height
       ang   (dxf 50 elst) ; rotation angle in UCS
       attpt (dxf 71 elst) ; attachment point code
 )

 ;|--------------------------------------------------------------
 ;;  CAB 01/24/2006 removed as the ang fron DXF code 50 os in UCS
 ;;  correct for UCS
 (setq  ang (- ang (angle (trans '(0.0 0.0 0.0) 1 0)
                          (trans '(1.0 0.0 0.0) 1 0)))
 )
 ;;  angles  90 = (/ pi 2)   180 = pi  270 = (* pi 1.5)
 ---------------------------------------------------------------|;

 
 ;;  Get upper left (ul) from insert point (p10)
 (cond ((= attpt 1) (setq ul p10)) ; top left
       ((= attpt 2) (setq ul (polar p10 (+ pi ang) (/ wid 2)))) ; top center
       ((= attpt 3) (setq ul(polar p10 (+ pi ang) wid))) ; top right
       ((= attpt 4) (setq ul (polar p10 (+ (/ pi 2) ang) (/ hgt 2)))) ; middle left
       ((= attpt 5) ; middle center
        (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
       ((= attpt 6) ; middle right
        (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) (+ (/ hgt 2)))))
       ((= attpt 7) (setq ul (polar p10 (+(/ pi 2) ang) hgt))) ; bottom left
       ((= attpt  ; bottom center
        (setq ul (polar (polar p10 (+ pi ang) (/ wid 2)) (+ (/ pi 2) ang) hgt)))
       ((= attpt 9) ; bottom right
        (setq ul (polar (polar p10 (+ pi ang) wid) (+ (/ pi 2) ang) hgt)))
 );cond
 (setq ur (polar ul ang wid)
       lr (polar ur (+ ang (* pi 1.5)) hgt)
       ll (polar lr (+ ang pi) wid)
 );setq
 (list ll lr ur ul)
);boxmtext

  • Thanks 1
Link to comment
Share on other sites
gilsoto13 Community Regular

gilsoto13

Posted
  • Author
Posted

Well... I didn´t undestand it very well... I did some extra research and I accomplished something I wanted by just adding a few lines to original lisp

 

I wanted this routine to do as textmask do.. a mask adjusted to mtext value box... it actually uses a function to create a wipeout box (I think the function gets the text value size)

because when you have mtext objects with extra large boxes (grips, control points) you get an extra-sized mask...

 

(defun acet-textmask-make-wipeout (ENT OSET / TXT TXTLAY TBX WIPOUT TXTYP TXTSTR)

 (setq TXT    (entget ENT (list "*"))               ; Get the text's edata
       TXTLAY (cdr (assoc 8 TXT))                   ; Get the layer of the text
       TXTYP  (cdr (assoc 0 TXT))                   ; Text or Mtext
       TXTSTR (cdr (assoc 1 TXT))
 )

 (if (/= TXTSTR "")
   (progn

     (if (= TXTYP "TEXT")
       (acet-ucs-cmd (list "_object" ENT))              ; set UCS to object
       (acet-ucs-to-object ENT)
     )

     (setq TBX (acet-geom-textbox TXT OSET))              ; Get the points around the text

     (if TBX
       (progn
         (command "_.pline")                        ; Create bounding pline box
          (while TBX
           (command (car TBX))
           (setq TBX (cdr TBX))
         )
         (command "_c")

         (command "_.wipeout" "_Polyline" (entlast) "_yes")  ; create wipeout entity

 

so I just turned the width and height= zero (In red)... so the mask fits to text value... in all cases... so done

 

but I would prefer to use... if possible, the express function to modify (or set) each mtext size according to its text value.

Link to comment
Share on other sites
gilsoto13 Community Regular

gilsoto13

Posted
  • Author
Posted

Great!

 

Thank you Charles... I will try to use your subroutine... That's exactly what I needed. I'll return here when I am done with this.

Link to comment
Share on other sites
LEsq Enthusiast

LEsq

Posted
Posted

I was under the impression that was required to fit the grips to the actual text paragraph width and height.

 

Have not tried any of the code posted so far - and do not know if by by having extracted the fit width and height it will allow to be updated by using subst and entmod from lisp - I know that from vlisp the width can be done.

Link to comment
Share on other sites
  • 1 month later...
gilsoto13 Community Regular

gilsoto13

Posted
  • Author
Posted (edited)

I found the best routine fot this task in this thread, by Rogerio Brazil

http://discussion.autodesk.com/forums/thread.jspa?threadID=448625&tstart=0

 

and also Lee Mac's routine was good enough, but I wanted multiple selection, so I stood with Rogerio Brazil's routine ...

http://www.cadtutor.net/forum/showpost.php?p=230733&postcount=11

 

and the routine ended up like this... Special Thanks alan J. Thompson and Marco Jacinto for all their help.

 
;;; ;BA.lsp  -BACKGROUND FILL ALL-
;;; ;Made for M3 Mexicana. Coding Selected by Paulo Gil. December 2009
;;; ;This routine will set a background color fill to all selected text, 
;;; ;mtext and dimensions, it will update dimensions to current Dimstyle
;;; with
;;; ;Dimtfill set to 1 temporarily for this purpose, so it works for current 
;;; ;Dimscale only, text objects will be converted to mtext with width=0
;;; ;and then will add their text box control points
;;; ;It will bring objects in layer 'Dims' to front at the end, as well as other
;;; ;Draworder operations according to M3 standards.
;;; ;Reviewed and modified by: Alan J. Thompson.
;;; ;And Marco Antonio Jacinto Perez 'mcoan001@hotmail.com'
;;; ;December 2009
;;;
;;; ; Some part of code from Tom Beauford, from AUGI
;;; ;[url]http://forums.augi.com/showthread.php?t=77962[/url]
;;; ; Set 'Border Offset Factor' to 1.15
(VL-LOAD-COM)
(DEFUN c:BA (/ *error* ttm2 ss elist sel1 sel3 dimt)
;;; error handler
 (DEFUN *error* (#Message)
   (AND dimt (SETVAR "dimtfill" dimt))
   (AND #Message
 (NOT (WCMATCH (STRCASE #Message) "*BREAK*,*CANCEL*,*QUIT*"))
 (PRINC (STRCAT "\nError: " #Message))
   ) ;_ and
 ) ;_ defun
 ;;Using code from Roberto Gonzalez -robierzogg- from HISPACAD
 ;; [url]http://www.hispacad.com/foro/viewtopic.php?p=142823&sid=b23c3147d2a06a29d1dfd60078f79c08[/url]
;;;This routine works only if Express tools are installed
;;; Convert selected text into Mtext 

 (COMMAND "undo" "begin")  ;beginning of undo group
 (DEFUN ttm2 (name_n / collect n name_n insertpt name_n1 newlist)
   (SETQ insertpt (ASSOC 10 (ENTGET name_n)))
    ; Convert Text to Mtext, using the
    ; EXPRESS
    ; command
   (COMMAND "txt2mtxt" name_n "")
    ; We set their original insertion point
    ; here
;;;creo que esta parte mueve los nuevos mtextos de posicion hacia arriba
;;;no se por que lo pusieron?
   (SETQ name_n1 (ENTLAST))
   (SETQ newlist (SUBST insertpt
   (ASSOC 10 (ENTGET name_n1))
   (ENTGET name_n1)
   )
   )
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(71 . 7)
   (ASSOC 71 (ENTGET name_n1))
   (ENTGET name_n1)
   )
   )
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(46 . 0)
   (ASSOC 46 (ENTGET name_n1))
   (ENTGET name_n1)
   )
   )
   (ENTMOD newlist)
   (SETQ newlist (SUBST '(41 . 0)
   (ASSOC 41 (ENTGET name_n1))
   (ENTGET name_n1)
   )
   )
   (ENTMOD newlist)
 ) ;_ defun

 ;;
 ;;
;;; Aqui pongo la variable Mtexts como un parametro, el cual corresponde al ss
;;; que vas creando con los nuevos Mtextos
 (DEFUN mw5 (mtexts / mtexts idx ename EntData dxf42 dxf43 EntData1)
    ;Reset Width - Mtext
   (IF mtexts
;;;Aqui se hace el cambio para que en lugar
;;; de cambiar todos los mtextos, solo modifique los que recien creaste
;;;(setq mtexts (ssget "_X" '((0 . "MTEXT"))))
     (PROGN
(SETQ idx 0)
(REPEAT (SSLENGTH mtexts)
  (SETQ ename (SSNAME mtexts idx))
  (SETQ EntData (ENTGET ename '("*")))
  (SETQ dxf42 (* (CDR (ASSOC 42 EntData))1.015))
  (SETQ dxf43 (CDR (ASSOC 43 EntData)))
  (SETQ EntData1
  (ENTMOD (SUBST (CONS 41 dxf42) (ASSOC 41 EntData) EntData))
  )
  (ENTMOD (SUBST (CONS 46 dxf43) (ASSOC 46 EntData1) EntData1)
  )
  (SETQ idx (1+ idx))
)    ;progn
     )     ;repeat
     (PRINC "\n Null Selection!")
   )     ;if
   (PRINC)
 )

 ;;
 ;;
 ;;    ; MAIN ROUTINE
 ;;
 ;;
 (SETQ dimt (GETVAR "dimtfill"))
 (SETVAR "dimtfill" 1)
 (PRINC
   "\nSelect Dimensions and text to apply the background fill and update...: "
 )
 (AND (SETQ ss (SSGET "_:L" '((0 . "MTEXT,*DIMENSION*,TEXT"))))
      (FOREACH x (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX ss)))
 (COND
   ((EQ "MTEXT" (CDR (ASSOC 0 (SETQ elist (ENTGET x)))))
    (VLA-PUT-BACKGROUNDFILL
      (VLAX-ENAME->VLA-OBJECT x)
      :VLAX-TRUE
    )
    (SETQ elist (SUBST (CONS 41 0.0) (ASSOC 41 elist) elist)
   elist (SUBST (CONS 46 0.0) (ASSOC 46 elist) elist)
   elist (SUBST (CONS 45 1.15) (ASSOC 45 elist) elist)
   elist (SUBST (CONS 421 256) (ASSOC 421 elist) elist)
    ) ;_ setq
    (ENTMOD elist)
   )
   ((EQ "TEXT" (CDR (ASSOC 0 (ENTGET x))))
    (ttm2 x)
    (SSDEL x ss)
    (VLA-PUT-BACKGROUNDFILL
      (VLAX-ENAME->VLA-OBJECT (SETQ elist (ENTLAST)))
      :VLAX-TRUE
    )
    (SSADD elist ss)
    (SETQ elist (ENTGET elist))
    (SETQ elist (SUBST (CONS 45 1.15) (ASSOC 45 elist) elist)
   elist (SUBST (CONS 421 256) (ASSOC 421 elist) elist)
    ) ;_ setq
    (ENTMOD elist)
   )
   (T T)
 ) ;_ cond
      ) ;_ foreach
      (VL-CMDF "_.-dimstyle" "_apply" ss "")
      (VL-CMDF "_.draworder" ss "" "_f")
 ) ;_ and
(setq 
   BkLst 
          '("CENTER LINE2"   "COLUMN ROW BUBBLE2"  "DETAIL BUBBLE 12" 
            "DETAIL BUBBLE2"     "DUST PICK UP POINT2"     "EQUIPMENT TAG2" 
            "FULL SECTION LR2"     "FULL SECTION UD2"     "FULL SECTION2"  
            "MATCH LINE SP2"     "MATCH LINE2"     "NORTH ARROW2"     
            "NOTE BOX2"     "NOTE ENCL2"     "PARTIAL SECTION T2"     
            "PARTIAL SECTION2"     "PLATE2"     "REVISION2"     
            "SAMPLE NUMBER2"     "SECTION CUT UD2"     "SECTION CUT2"     
            "STAMP BIG2"     "STAMP SMALL2"     "STREAM NUMBER2"     
            "STREAM SEQUENCE2"     "TAG2"     "TITLE 12"     
            "TITLE BUBBLE 12"     "TITLE BUBBLE2"     "TITLE2"     
            "WORK POINT2"     "ROOMTAG"     "ROOMTAG2"     "DOORTAG"     
            "WALLTAG"     "WINDOWTAG"     "MULTIPLE DETAIL"     
            "IND WALL CEIL 1"     "IND WALL UP 1"     "IND WALL L 1"  
            "IND WALL R 1"     "IND WALL DN 1"     "MULTIPLE DETAIL"
       ) 
   NomBloques (car BkLst) 
   BkName     (mapcar '(lambda    (x) 
             (setq NomBloques (strcat NomBloques "," x)) 
           ) 
              (cdr BkLst) 
          ) 
 ) 
 (if (setq sel5 (ssget "_X" (list '(-4 . "<OR") 
                   ; _Se seleccionan todos los bloques de 
                   ; usuario, despues se procesaran los 
                   ; nombres esto para poder procesar los 
                   ; bloques dinamicos 
                  '(-4 . "<AND") 
                  '(0 . "INSERT") 
                  (cons 2 (strcat NomBloques ",`*U*")) 
                  '(-4 . "AND>") 
                  '(-4 . "OR>") 
            ) 
         ) 
     ) 

   (VL-CMDF "_.draworder" sel5 "" "_f")
 ) ;_ if
 (IF (SETQ sel4
     (SSGET
       "_X"
       '((0
   .
   "line,lwpolyline,insert,polyline,arc,circle,spline,hatch,region"
  )
 )
     )
     )
   (VL-CMDF "_.draworder" sel4 "" "_b")
 ) ;_ if
 (IF (SETQ sel1 (SSGET "_X" '((0 . "leader,*Dimension*"))))
   (VL-CMDF "_.draworder" sel1 "" "_f")
 ) ;_ if
 (IF (SETQ sel3
     (SSGET "_X"
     '((0 . "line,lwpolyline,polyline")
       (8 . "Dims,Ar-Dims,G-Dims,M-Dims,E-Dims,S-Dims,P-Dims")
      )
     ) ;_ ssget
     ) ;_ setq
   (VL-CMDF "_.draworder" sel3 "" "_f")
 ) ;_ if
 (SETVAR "dimtfill" dimt)
 (PRINC)
 (COMMAND "undo" "end")  ;end of undo group
 (mw5 ss)
) ;_ defun
(PRINC
 "\Type \"BA\" to mask all text, mtext and dimensions, adding mtext box"
)
(PRINC
 "\Remember to set dimscale according to selected dimensions before using it."
)
;|«Visual LISP© Format Options»
(80 2 40 2 nil "end of " 60 9 2 0 0 T T T T)
;*** DO NOT add text below the comment! ***|;

Edited by SLW210
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...