Author Topic: Call "Textmask" from Expresstools from Lisp?  (Read 2394 times)

0 Members and 1 Guest are viewing this topic.

Peter2

  • Swamp Rat
  • Posts: 650
Call "Textmask" from Expresstools from Lisp?
« on: October 27, 2016, 11:46:16 AM »
I want to create a "Textmask" (from Expresstools) for my "last"-Element, a simple text. Using ..
Code - Auto/Visual Lisp: [Select]
  1. (command "-textmask" "_offset" "0.35" "Masktype" "_wipeout""_Last")
results in an error with something like
Quote
Invalid selection. Expects a Point or Quit ..
If I type the same strings one by one into the command-line, then it works fine.
Any idea how to solve it?

Peter
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #1 on: October 27, 2016, 12:25:35 PM »
TEXTMASK is an AutoLISP program, therefore you'll need to use something like:
Code - Auto/Visual Lisp: [Select]
  1. (if (setq txt (ssget "_L" '((0 . "TEXT"))))
  2.     (acet-textmask-make-wipeout (ssname txt 0) 0.35)
  3. )

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #2 on: October 27, 2016, 12:41:28 PM »
Perhaps you could use MTEXT .. then you'd have a background mask to use.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Peter2

  • Swamp Rat
  • Posts: 650
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #3 on: October 27, 2016, 12:58:45 PM »
TEXTMASK is an AutoLISP program, therefore you'll need to use something like:...
Great - thanks Lee  :-)

Perhaps you could use MTEXT .. then you'd have a background mask to use.
Thanks ronjonp, but due to other handling problems I prefer Text.
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

leftdefense

  • Mosquito
  • Posts: 3
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #4 on: January 13, 2023, 03:43:20 PM »
Hi guys,
Anyone knows the ACET-* function to remove a TextMask (ExpressTools Command TextUnMask)?

I have this dynamic command that the user can add a textmask using acet-textmask-make-wipeout, but i would like to give him an option to remove it later on. I would prefer not to code and mess with the groups and wipeout myself.

zak26

  • Newt
  • Posts: 33
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #5 on: January 13, 2023, 08:12:26 PM »
Maybe this will help
Code: [Select]
  (if (not acet-textmask-unmask) (load "textmask.lsp"))
  (setq glst (acet-textmask-group-list))
  (if (setq txt (ssget '((0 . "TEXT"))))
    (foreach text (vl-remove-if 'listp (mapcar 'cadr (ssnamex txt)))
      (acet-textmask-unmask text glst)
    )
  )

leftdefense

  • Mosquito
  • Posts: 3
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #6 on: January 17, 2023, 10:26:05 AM »
Thanks a lot @zak26. Right on.

For others like me on BricsCAD or otherCAD, here is a AutoCAD 2019 textmask.lsp version which may be useful.

kirby

  • Newt
  • Posts: 127
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #7 on: January 17, 2023, 02:49:25 PM »
Express tools like Testmask.lsp have a bunch of external dependencies, they are listed in the header comments...

JohnK

  • Administrator
  • Seagull
  • Posts: 10603
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #8 on: January 17, 2023, 03:30:31 PM »
I was always told not to use the AECT-*** functions. Did anyone do a search here to see if someone rolled their own?
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

kirby

  • Newt
  • Posts: 127
Re: Call "Textmask" from Expresstools from Lisp?
« Reply #9 on: January 18, 2023, 09:34:25 AM »
Might need this someday, so made use of caffeine rush and rolled my own.

Calling command is 'TestTW', used internal function that creates the textbox.  Uses an older version of CAB's textbox routine to create an oriented bounding box around a text entity (see links to older and newer version of this in code...thanks CAB!)

All old school using commands (no vl) and over-commented because you don't know who might want to dissect/repurpose this.

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TestTW ( / MyEntSel MyEnt MyNewWipeout)
  2. ; Test function for 'TextWipeout'
  3. ; KJM - Jan 2023
  4. ; Uses custom functions:
  5. ;       TextWipeout
  6.  
  7. ; Select text entity
  8. (setq MyEntSel (entsel "\nSelect a text entity to create wipeout..."))
  9. (setq MyEnt (car MyEntSel))
  10.  
  11. ; Create wipeout using custom function
  12. (setq MyNewWipeout (textwipeout MyEnt 1 0.2))
  13. (prompt "\n  Wipeout created = ")(princ MyNewWipeout)(princ)
  14. )
  15.  
  16.  
  17.  
  18.  
  19. (defun TextWipeout (TextEnt WipeoutLayer OffsetFrac /
  20.                 MyEntData MyEntType MyTextHeight MyOffsetDist MyTextLayer MyTextBox OldOsnap
  21.                 MyPolyEnt P1 P2 PM POutside MyOffsetEnt MyWipeoutEnt MyWipeoutLayer OldLayer
  22.                 )
  23. ; Internal function to make a wipeout for a TEXT entity
  24. ; KJM - Jan 2023
  25. ; Input:
  26. ;       TextEnt - (ename) TEXT entity (not Mtext, attribute, etc)
  27. ;       WipeoutLayer - (string or integer code) layer name for wipeout entities, or integer code
  28. ;                       integer codes:
  29. ;                               0 or nil = use current layer
  30. ;                               1 = use hard coded default layer name "_Wipeout"
  31. ;                               2 = use TEXT entity layer
  32. ;       OffsetFrac - (real) wipeout offset distance outside of text entity limits, as fraction of text height                          
  33. ;                       nil = 0.1 (default)
  34. ; Returns:
  35. ;       ename of wipeout entity if one was created, nil if not created
  36. ; Uses custom functions:
  37. ;       box_dtext (by CAB)
  38. ;       midpoint
  39.  
  40. (setq OutVal nil)
  41.  
  42.  
  43. ; defaults and constants
  44. (if (not hpi) (setq hpi (* 0.5 pi)))            ; half pi aka 90 degrees
  45. (if (not OffsetFrac) (setq OffsetFrac 0.1))     ; offset distance as fraction of text height
  46. (if (not WipeoutLayer) (setq WipeoutLayer 0))   ; default to use current layer for wipeout entities
  47.  
  48.  
  49. ; Get text entity info
  50. (setq MyEntData (entget TextEnt))
  51. (setq MyEntType (strcase (cdr (assoc 0 MyEntData))))
  52.  
  53.  
  54.  
  55. ; Only proceed if TEXT entity was selected
  56. (if (eq MyEntType "TEXT")
  57.   (progn
  58.         ; Get text info
  59.         (setq MyTextHeight (cdr (assoc 40 MyEntData)))          ; text height
  60.         (setq MyOffsetDist (* OffsetFrac MyTextHeight))         ; convert fractional offset distance to real units
  61.         (setq MyTextLayer (cdr (assoc 8 MyEntData)))            ; text layer
  62.  
  63.  
  64.         ; Get oriented bounding box as list of (0-PLL 1-PLR 2-PUR 3-PUL) using CAB's custom routine
  65.         (setq MyTextBox (box_dtext MyEnt))
  66.  
  67.         ; Draw boundary polyline
  68.         (setq OldOsnap (getvar "OSMODE"))
  69.         (setvar "OSMODE" 0)
  70.                
  71.         (command ".pline" (nth 0 MyTextBox) (nth 1 MyTextBox) (nth 2 MyTextBox) (nth 3 MyTextBox) "c")
  72.         (setq MyPolyEnt (entlast))
  73.  
  74.         ; Get point on outside of polyline to represent offset direction
  75.         (setq P1 (nth 0 MyTextBox))     ; lower left corner of bounding box
  76.         (setq P2 (nth 1 MyTextBox))     ; lower right corner of bounding box
  77.         (setq PM (midpoint P1 P2))      ; get midpoint using custom routine (likely not necessary)
  78.         (setq POutside (polar PM (- (angle P1 P2) hpi) MyOffsetDist))           ; point on right hand side of segment P1-P2 (outside of polyline)
  79.  
  80.         ; Offset the polyline
  81.         (command ".offset" MyOffsetDist MyPolyEnt POutside "")
  82.         (setq MyOffsetEnt (entlast))
  83.        
  84.         (setvar "OSMODE" OldOsnap)     
  85.        
  86.         ; Lose original poly
  87.         (entdel MyPolyEnt)
  88.        
  89.         ; Make a Wipeout from the offset polyline
  90.         (command ".wipeout" "P" MyOffsetEnt "Y")
  91.         (setq MyWipeoutEnt (entlast))
  92.        
  93.         ; Change draworder of wipeout to underneath text entity
  94.         (command ".draworder" MyWipeoutEnt "" "U" TextEnt "")  
  95.        
  96.         ; Change layer of wipeout
  97.         (setq MyWipeoutLayer nil)
  98.         (cond
  99.                 ((eq (type WipeoutLayer) 'INT)          ; Process integer codes to determine layer name
  100.                         (cond
  101.                                 ; omit null case of WipeoutLayer = 0
  102.                                 ((eq WipeoutLayer 1)
  103.                                         (setq MyWipeoutLayer "_Wipeout")        ; hard coded layer name
  104.                                 )
  105.                                 ((eq WipeoutLayer 2)
  106.                                         (setq MyWipeoutLayer MyTextLayer)       ; same layer as text entity
  107.                                 )
  108.                                
  109.                         ) ; close cond
  110.                 )
  111.                
  112.                 ((eq (type WipeoutLayer) 'STR)          ; Use provided string for layer name
  113.                         (setq MyWipeoutLayer WipeoutLayer)                      ; string layer name was specified
  114.                 )
  115.         ) ; close cond
  116.        
  117.  
  118.         ; Move wipeout to dedicated layer, etc...
  119.         (if MyWipeoutLayer
  120.           (progn
  121.                 (setq OldLayer (getvar "CLAYER"))
  122.                 (command ".layer" "m" MyWipeoutLayer "s" OldLayer "")
  123.                 (command ".change" MyWipeoutEnt "" "P" "LA" MyWipeoutLayer "")
  124.           )
  125.         ) ; close if
  126.        
  127.         ; Return ename of wipeout
  128.         (setq OutVal MyWipeoutEnt)
  129.   )    
  130. ) ; close if
  131.  
  132. OutVal
  133. )
  134.  
  135.  
  136.  
  137. (defun C:TestBoxDtext ( / MyEntSel MyEnt MyTextBox)
  138. ; Test function for 'Box_Dtext' by CAB
  139. ; KJM - Jan 2009
  140. ; Uses custom functions:
  141. ;       Box_Dtext
  142.  
  143. ; Select text entity
  144. (setq MyEntSel (entsel "\nSelect a text entity..."))
  145. (setq MyEnt (car MyEntSel))
  146.  
  147. ; Get oriented bounding box as list of (0-PLL 1-PLR 2-PUR 3-PUL) using CAB's custom routine
  148. (setq MyTextBox (box_dtext MyEnt))
  149.  
  150. ; Draw boundary polyline
  151. (command ".pline" (nth 0 MyTextBox) (nth 1 MyTextBox) (nth 2 MyTextBox) (nth 3 MyTextBox) "c")
  152. )
  153.  
  154.  
  155.  
  156.  
  157.  
  158. (defun Box_Dtext (ent /
  159.                 i ename elist lst lst2 tb tb1 tb2 tlen thi ll lr
  160.                 ur ul ang angg UCSang llx lrx urx ulx lly lry ury uly all
  161.                 avg err cntlst
  162.                 )
  163. ; Return bounding box coordinates for a dtext object in any UCS and at any angle, by CAB
  164. ;       https://www.theswamp.org/index.php?topic=31355.msg369262#msg369262
  165. ; Newer version 2.4 here:
  166. ;       http://www.theswamp.org/index.php?topic=7003.msg86092#msg86092
  167. ;
  168. ;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  169. ;;;       +                   box_text                             +
  170. ;;;       +            Created by C. Alan Butler                   +
  171. ;;;       +               Copyright 2005                           +
  172. ;;;       +   by Precision Drafting & Design All Rights Reserved.  +
  173. ;;;       +    Contact at ab2draft@TampaBay.rr.com                 +
  174. ;;;       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  175. ;;;
  176. ;;; VERSION
  177. ;;;  1.2 Jan 24, 2006  UCS corrections
  178. ;;;  1.3 Nov 26, 2008  Fixed Bug when text was rotated
  179. ;;;
  180. ;;; FUNCTION
  181. ;;;  Return Box coordinates for an dtext object in any UCS, any angle.
  182. ;;;
  183. ;;; USAGE
  184. ;;;  (box_text ent)
  185. ;;;
  186. ;;; ARGUMENTS
  187. ;;;  ent = text ename
  188. ;;;
  189. ;;;  RETURNS
  190. ;;;   list of 4 points for box,  (ll lr ur ul)
  191. ;;;
  192. ;;; PLATFORMS
  193. ;;;  2000+ Tested in 2000 only
  194. ;;; FUNCTION
  195.  
  196.  
  197.   (setq UCSang (angle (trans '(0.0 0.0 0.0) 1 0)
  198.                       (trans '(1.0 0.0 0.0) 1 0)))
  199.  
  200.   ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  201.   ;;      get the bounding box
  202.   ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  203.     (setq elist (entget ent)
  204.           ang   (cdr (assoc 50 elist)) ; text angle
  205.           tb    (textbox elist) ; Note that I had some problems with this
  206.           ;tb    (textbox (list (assoc 1 elist) (assoc 40 elist)(assoc 7 elist)));(textbox (list (assoc 1 elist))) ; CAB 11.11.08
  207.           tb1   (car tb)  ; Lower Left Relative to text
  208.           tb2   (cadr tb) ; Upper Right relative to text
  209.           tlen  (- (car tb2) (car tb1))
  210.           thi   (- (cadr tb2) (cadr tb1))
  211.     )
  212.     (setq ang   (- ang UCSang) ; correct for UCS
  213.           ll  (polar (trans (cdr (assoc 10 elist)) 0 1)
  214.                      (+ (angle '(0 0) tb1) ang) (DISTANCE '(0 0) tb1)) ; CAB 11.26.2008
  215.           lr    (polar ll ang tlen)
  216.           ur    (polar ll (+ ang (angle tb1 tb2)) (distance tb1 tb2))
  217.           ul    (polar ll (+ ang (/ pi 2)) thi)
  218.     )
  219.   ;;+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-
  220.     (list ll lr ur ul)
  221. )
  222.  
  223.  
  224. (defun MidPoint (P1 P2 / NewX NewY NewZ OutVal)
  225. ; Midpoint of 2 points in X-Y coordinate system
  226. ; KJM - Dec 2002
  227. ; Input:
  228. ;       P1, P2 - (points) two points
  229. ; Returns:
  230. ;       midpoint of P1 and P2
  231.  
  232.  
  233. (setq NewX (* 0.5 (+ (car P1) (car P2))))
  234. (setq NewY (* 0.5 (+ (cadr P1) (cadr P2))))
  235. (setq NewZ (* 0.5 (+ (caddr P1) (caddr P2))))
  236.  
  237. (setq OutVal (list NewX NewY NewZ))
  238. OutVal          ; return midpoint
  239. )
  240.