(defun C:TestTW
( / MyEntSel MyEnt MyNewWipeout
) ; Test function for 'TextWipeout'
; KJM - Jan 2023
; Uses custom functions:
; TextWipeout
; Select text entity
(setq MyEntSel
(entsel "\nSelect a text entity to create wipeout..."))
; Create wipeout using custom function
(setq MyNewWipeout
(textwipeout MyEnt
1 0.2)) )
(defun TextWipeout
(TextEnt WipeoutLayer OffsetFrac
/ MyEntData MyEntType MyTextHeight MyOffsetDist MyTextLayer MyTextBox OldOsnap
MyPolyEnt P1 P2 PM POutside MyOffsetEnt MyWipeoutEnt MyWipeoutLayer OldLayer
)
; Internal function to make a wipeout for a TEXT entity
; KJM - Jan 2023
; Input:
; TextEnt - (ename) TEXT entity (not Mtext, attribute, etc)
; WipeoutLayer - (string or integer code) layer name for wipeout entities, or integer code
; integer codes:
; 0 or nil = use current layer
; 1 = use hard coded default layer name "_Wipeout"
; 2 = use TEXT entity layer
; OffsetFrac - (real) wipeout offset distance outside of text entity limits, as fraction of text height
; nil = 0.1 (default)
; Returns:
; ename of wipeout entity if one was created, nil if not created
; Uses custom functions:
; box_dtext (by CAB)
; midpoint
; defaults and constants
(if (not hpi
) (setq hpi
(* 0.5 pi
))) ; half pi aka 90 degrees (if (not OffsetFrac
) (setq OffsetFrac
0.1)) ; offset distance as fraction of text height (if (not WipeoutLayer
) (setq WipeoutLayer
0)) ; default to use current layer for wipeout entities
; Get text entity info
; Only proceed if TEXT entity was selected
(if (eq MyEntType
"TEXT") ; Get text info
(setq MyTextHeight
(cdr (assoc 40 MyEntData
))) ; text height (setq MyOffsetDist
(* OffsetFrac MyTextHeight
)) ; convert fractional offset distance to real units
; Get oriented bounding box as list of (0-PLL 1-PLR 2-PUR 3-PUL) using CAB's custom routine
(setq MyTextBox
(box_dtext MyEnt
))
; Draw boundary polyline
; Get point on outside of polyline to represent offset direction
(setq P1
(nth 0 MyTextBox
)) ; lower left corner of bounding box (setq P2
(nth 1 MyTextBox
)) ; lower right corner of bounding box (setq PM
(midpoint P1 P2
)) ; get midpoint using custom routine (likely not necessary) (setq POutside
(polar PM
(- (angle P1 P2
) hpi
) MyOffsetDist
)) ; point on right hand side of segment P1-P2 (outside of polyline)
; Offset the polyline
(command ".offset" MyOffsetDist MyPolyEnt POutside
"")
; Lose original poly
; Make a Wipeout from the offset polyline
(command ".wipeout" "P" MyOffsetEnt
"Y")
; Change draworder of wipeout to underneath text entity
(command ".draworder" MyWipeoutEnt
"" "U" TextEnt
"")
; Change layer of wipeout
(setq MyWipeoutLayer
nil) ((eq (type WipeoutLayer
) 'INT
) ; Process integer codes to determine layer name ; omit null case of WipeoutLayer = 0
(setq MyWipeoutLayer
"_Wipeout") ; hard coded layer name )
(setq MyWipeoutLayer MyTextLayer
) ; same layer as text entity )
) ; close cond
)
((eq (type WipeoutLayer
) 'STR
) ; Use provided string for layer name (setq MyWipeoutLayer WipeoutLayer
) ; string layer name was specified )
) ; close cond
; Move wipeout to dedicated layer, etc...
(command ".layer" "m" MyWipeoutLayer
"s" OldLayer
"") (command ".change" MyWipeoutEnt
"" "P" "LA" MyWipeoutLayer
"") )
) ; close if
; Return ename of wipeout
(setq OutVal MyWipeoutEnt
) )
) ; close if
OutVal
)
(defun C:TestBoxDtext
( / MyEntSel MyEnt MyTextBox
) ; Test function for 'Box_Dtext' by CAB
; KJM - Jan 2009
; Uses custom functions:
; Box_Dtext
; Select text entity
(setq MyEntSel
(entsel "\nSelect a text entity..."))
; Get oriented bounding box as list of (0-PLL 1-PLR 2-PUR 3-PUL) using CAB's custom routine
(setq MyTextBox
(box_dtext MyEnt
))
; Draw boundary polyline
)
i ename elist lst lst2 tb tb1 tb2 tlen thi ll lr
ur ul ang angg UCSang llx lrx urx ulx lly lry ury uly all
avg err cntlst
)
; Return bounding box coordinates for a dtext object in any UCS and at any angle, by CAB
; https://www.theswamp.org/index.php?topic=31355.msg369262#msg369262
; Newer version 2.4 here:
; http://www.theswamp.org/index.php?topic=7003.msg86092#msg86092
;
;;; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;; + box_text +
;;; + 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
;;; 1.3 Nov 26, 2008 Fixed Bug when text was rotated
;;;
;;; FUNCTION
;;; Return Box coordinates for an dtext object in any UCS, any angle.
;;;
;;; USAGE
;;; (box_text ent)
;;;
;;; ARGUMENTS
;;; ent = text ename
;;;
;;; RETURNS
;;; list of 4 points for box, (ll lr ur ul)
;;;
;;; PLATFORMS
;;; 2000+ Tested in 2000 only
;;; FUNCTION
(trans '
(1.0 0.0 0.0) 1 0)))
;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
;; get the bounding box
;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
tb
(textbox elist
) ; Note that I had some problems with this ;tb (textbox (list (assoc 1 elist) (assoc 40 elist)(assoc 7 elist)));(textbox (list (assoc 1 elist))) ; CAB 11.11.08
tb1
(car tb
) ; Lower Left Relative to text tb2
(cadr tb
) ; Upper Right relative to text )
(setq ang
(- ang UCSang
) ; correct for UCS (+ (angle '
(0 0) tb1
) ang
) (DISTANCE '
(0 0) tb1
)) ; CAB 11.26.2008 ul
(polar ll
(+ ang
(/ pi
2)) thi
) )
;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
)
(defun MidPoint
(P1 P2
/ NewX NewY NewZ OutVal
) ; Midpoint of 2 points in X-Y coordinate system
; KJM - Dec 2002
; Input:
; P1, P2 - (points) two points
; Returns:
; midpoint of P1 and P2
OutVal ; return midpoint
)