On Sun, 04 Jan 2004 19:57:04 +0100, MRL
I got this lisp routine to work on 2004 by deleting the references to wipeout.arx (see below)... it may not be good programming, but it works for me. KL. .... ;;global function ;;test function to see if AcWipeout.arx is available (defun C:MaskDimText ( / cecho oldlyr ent flag outer boxmtext lwrect ) ;;local functions ;;;--------------------boxmtext------------------------------------- ;;; 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 2);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 ;;;-------------------------lwrect------------------------------------ ;;; 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 ss pent) (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 (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" "WIPEOUTS" "") (setq ss (ssadd)) ;;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)) pent (car (last alist));parent entity ) (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" "p" (entlast) "y") (ssadd (entlast) ss);adds wipeout to selection set (ssadd pent ss);add parent entity to selection set
;;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 (command "_.wipeout" "F" "OFF") ;;restore sysvars & end UNDO group (setvar "CMDECHO" cecho) (setvar "CLAYER" oldlyr) (command "_.group" "C" "*" "" ss "");jp (command "_.UNDO" "END") );progn (princ)
);C:MaskDimText
