Author Topic: Find All Text That Does Not Have Text Width Factor = 1.0 Then Change Font  (Read 2863 times)

0 Members and 1 Guest are viewing this topic.

THansen

  • Guest
I am looking for a way to find ALL text that does not have a TEXT WIDTH FACTOR (TWF) = 1.0. Then I want to evaluate the current TEXT WIDTH FACTOR setting and substitute a different font with a TWF = 1.0 Example

This includes text in mtext, attributes, blocks, dynamic blocks, etc.

Rules:
1.) If TWF is between 0.96 and 1.04 then change font to Arial Regular and set TWF = 1.0
2.) If TWF is between 0.85 and 0.95 then change font to Arial Narrow Bold and set TWF = 1.0
2.) If TWF is between 0.75 and 0.84 then change font to Arial Narrow and set TWF to 1.0

I found Lee Mac's FixAllText which works great for changing all text attributes but I need it to do it selectively for the fonts based on current TWF.

Thanks for any help you can Provide.

mailmaverick

  • Bull Frog
  • Posts: 494
My modified code :

Code: [Select]
(defun c:AdjustTest ()
  ;; Made by Mailmaverick dated 14-08-2016
  ;; Updated dated 16-08-2016
  (vl-load-com)
  (if (not (tblsearch "STYLE" "ArialStyle"))
    (entmake '((0 . "STYLE")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbTextStyleTableRecord")
       (2 . "ArialStyle") ;style name
       (3 . "Arial.ttf") ;font file
       (70 . 0)
       (40 . 0.0)
       (41 . 1.0)
       (50 . 0.0)
       (71 . 0)
      )
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial" :vlax-false :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (if (not (tblsearch "STYLE" "ArialNarrowStyle"))
    (entmake '((0 . "STYLE")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbTextStyleTableRecord")
       (2 . "ArialNarrowStyle") ;style name
       (3 . "Arial Narrow.ttf") ;font file
       (70 . 0)
       (40 . 0.0)
       (41 . 1.0)
       (50 . 0.0)
       (71 . 0)
      )
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialNarrowStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial Narrow" :vlax-false :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (if (not (tblsearch "STYLE" "ArialNarrowBoldStyle"))
    (progn (setq objstyle (vlax-ename->vla-object
    (entmakex '((0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "ArialNarrowBoldStyle") ;style name
(3 . "Arial Narrow.ttf") ;font file
(70 . 0)
(40 . 0.0)
(41 . 1.0)
(50 . 0.0)
(71 . 0)
       )
    )
  )
   )
   (vla-GetFont objstyle 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)
   (vla-SetFont objstyle 'typeFace :vlax-true 'Italic 'charSet 'PitchandFamily)
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialNarrowBoldStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial Narrow" :vlax-true :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (setvar 'cmdecho 0)
  (prompt "\nSelect Texts")
  (if (setq sstext (ssget "_:L" '((0 . "*TEXT"))))
    (progn
      (repeat (setq n (sslength sstext))
(acet-ui-status (strcat (itoa n) " Texts remaining.") "Status")
(command "_.delay" 0)
(setq ent (ssname sstext (setq n (1- n))))
(setq obj (vlax-ename->vla-object ent))
(setq txtstr (vla-get-textstring obj))
(setq typ (strcase (vla-get-objectname obj)))
(if (vl-string-search "ACDBTEXT" typ)
  (progn ;; TEXT is PLAIN TEXT
(setq widfac (vla-get-Scalefactor obj))
(cond ((and (>= widfac 0.96) (<= widfac 1.04)) (vla-put-StyleName obj "ArialStyle"))
       ((and (>= widfac 0.85) (< widfac 0.96)) (vla-put-StyleName obj "ArialNarrowBoldStyle"))
       ((and (>= widfac 0.75) (< widfac 0.85)) (vla-put-StyleName obj "ArialNarrowStyle"))
       (T (princ (strcat "\nWidth Factor is not in given range for text : " txtstr)))
)
(vla-put-Scalefactor obj 1)
(entupd ent)
  )
  (progn ;; Text is MTEXT
(setq txtstrUC (strcase txtstr))
(setq idx 1)
(setq div (chr 124))
(setq txtstrlist nil)
(setq errhap nil)
(setq oldidx 1)
(while (and (not errhap) (setq idx (vl-string-search "\\W" txtstrUC idx)))
   (if (/= (substr txtstrUC (- idx 1) 1) "\\")
     (progn (setq found nil)
    (setq add 2)
    (setq widfac "")
    (while (not found)
      (setq tmp1 (substr txtstrUC (+ idx add) 1))
      (if (or (equal tmp1 div) (equal tmp1 ";") (equal tmp1 "\\"))
(progn (setq found T))
(progn (setq add (1+ add)) (setq widfac (strcat widfac tmp1)))
      )
    )
    (setq widfac (atof widfac))
    (cond ((and (>= widfac 0.96) (<= widfac 1.04)) (setq found T) (setq substr2 (strcat "\\fArial" div "B0")))
  ((and (>= widfac 0.85) (< widfac 0.96))
   (setq found T)
   (setq substr2 (strcat "\\fArial Narrow" div "B1"))
  )
  ((and (>= widfac 0.75) (< widfac 0.85))
   (setq found T)
   (setq substr2 (strcat "\\fArial Narrow" div "B0"))
  )
  (T (setq errhap T) (setq found nil))
    )
    (if found
      (progn (setq temptxt (substr txtstrUC oldidx idx))
     (if (setq fontstrtidx (- (vl-string-search "\F" txtstrUC) 1))
       (progn (setq fontendidx (+ (vl-string-search (strcat div "B") temptxt) 4))
      (setq substr1 (substr txtstr 1 fontstrtidx))
      (setq substr3 (substr txtstr fontendidx (- idx fontendidx)))
      (setq substr4 "\\W1")
      (setq BalanceText (substr txtstr (+ idx add)))
      (setq txtstrlist (append txtstrlist (list (strcat substr1 substr2 substr3 substr4))))
       )
       (progn (setq errhap T)
      (princ (strcat "\nWidth Factor Found but corresponding Font Nout Found in text : " txtstr))
       )
     )
      )
      (progn (setq errhap T) (princ (strcat "\nWidth Factor is not in given range for text : " txtstr)))
    )
     )
   )
   (setq oldidx idx)
   (if (not errhap)
     (setq idx (+ idx 1))
     (setq idx (strlen txtstr))
   )
)
(setq strr "")
(if (and txtstrlist BalanceText)
   (progn (foreach xx txtstrlist (setq strr (strcat strr xx)))
  (setq strr (strcat strr BalanceText))
  (vla-put-textstring obj strr)
   )
)
(entupd ent)
  )
)
      )
    )
  )
  (acet-ui-status)
  (princ "\n")
  (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport)
  (setvar 'cmdecho 1)
  (princ)
)

Kindly test and let me know.
Also if you can attach some sample file for debugging, it would be great.
« Last Edit: August 16, 2016, 02:31:23 AM by mailmaverick »

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18

THansen

  • Guest

Update on this.......I have found an alternate way to get fully searchable PDF provided Text Width Factor and/or Oblique angle are at default values.  This method does not require editing of the dwg file, just a re-publish of the PDF.

This is done by FORCING AutoCAD to substitute ttf for all the shx fonts.

1.) Delete the shx fonts from your workstation, including AutoCAD's default simplex.SHX.  You have to delete....I tried renaming the font file like TAH-romans.shx and AutoCAD still found it.  Then I renamed the folder to TAH-fonts and again AutoCAD still found it.  I just DELETED all *.SHX files I found from the C: search.

2.) Edit the acad.fmp file and remove all entries.  Save file as a blank file.

3.) Set the AutoCAD system variable FONTALT to your desired font.  I used Arial.ttf.

4.) When AutoCAD loads it will try to find the fonts used in the dwg file using the path specified in the support search path settings.  Since it cannot find them it will look at the acad.fmp file.  Since this file is empty it will then look at the font defined in the text style again and attempt to find it in other places (folders).  Since it still cannot find the file it will used the font stored in the AutoCAD FONTALT system variable which is Arial.ttf.

Mtext is shown in the text editor using the ttf equivalent of the shx font.  For .ttf fonts it will first look in the acad.fmp which is empty, then at the font defined in the text style, then Windows will substitute a similar font which in my case is Arial.ttf.

Once the drawing is opened, fonts have been substituted, and any file output is done using the true type font(s).  This works for DWF / DWFx to PDF or directly to PDF using simple PDF print drivers.

HOWEVER, if you have text with the Text Width Factor not equal to 1.0 and/or Text Oblique Angle not equal to 0.0 this text is still not searchable.

In our case 90% of our SHX based text becomes fully searchable where non of it did before  :2funny:

THansen

  • Guest
mailmaverickI was able to create a test drawing which is attached.  The lisp works on single line text but bombs out on mtext.  It also does not appear to work on dimension text, text in blocks, etc..  Please have a look.  Also when first loaded i get "; error: lisp value has no coercion to VARIANT with this type:  TYPEFACE" but when I run it again it works?


On Mtext it gives this "  ; error: bad argument value: positive 0"


My goal is to have all text with a Text Width Factor=1.0 and Text Oblique Angle = 0.0
Use Arial Font and Font Families including italic.......See text on sample drawing.


The error checking is good but I will be running this in batch mode on 100's of drawings.  So can it append any error messsages to a log file....maybe something like this.


File name xxx-xxxxxx.dwg

Width Factor is not in given range for text : APPLICATION RULES
Width Factor is not in given range for text : YES


File name xxxxxx.dwg
Width factor..........


File name xxxxxx
...........


Thanks for all your help.....I am starting to understand the code!




mailmaverick

  • Bull Frog
  • Posts: 494
Try my modified code :

Code: [Select]
(defun c:AdjustTest ()
  ;; Made by Mailmaverick dated 14-08-2016
  ;; Updated dated 16-08-2016
  (vl-load-com)
  (if (not (tblsearch "STYLE" "ArialStyle"))
    (entmake '((0 . "STYLE")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbTextStyleTableRecord")
       (2 . "ArialStyle") ;style name
       (3 . "Arial.ttf") ;font file
       (70 . 0)
       (40 . 0.0)
       (41 . 1.0)
       (50 . 0.0)
       (71 . 0)
      )
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial" :vlax-false :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (if (not (tblsearch "STYLE" "ArialNarrowStyle"))
    (entmake '((0 . "STYLE")
       (100 . "AcDbSymbolTableRecord")
       (100 . "AcDbTextStyleTableRecord")
       (2 . "ArialNarrowStyle") ;style name
       (3 . "Arial Narrow.ttf") ;font file
       (70 . 0)
       (40 . 0.0)
       (41 . 1.0)
       (50 . 0.0)
       (71 . 0)
      )
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialNarrowStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial Narrow" :vlax-false :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (if (not (tblsearch "STYLE" "ArialNarrowBoldStyle"))
    (progn (setq objstyle (vlax-ename->vla-object
    (entmakex '((0 . "STYLE")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "ArialNarrowBoldStyle") ;style name
(3 . "Arial Narrow.ttf") ;font file
(70 . 0)
(40 . 0.0)
(41 . 1.0)
(50 . 0.0)
(71 . 0)
       )
    )
  )
   )
   (vla-GetFont objstyle 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)
   (vla-SetFont objstyle "Arial Narrow" :vlax-true 'Italic 'charSet 'PitchandFamily)
    )
    (progn (setq entstyle (tblobjname "STYLE" "ArialNarrowBoldStyle"))
   (vla-SetFont (vlax-ename->vla-object entstyle) "Arial Narrow" :vlax-true :vlax-false 0 34)
   (entupd entstyle)
    )
  )
  (setvar 'cmdecho 0)
  (prompt "\nSelect Texts")
  (if (setq sstext (ssget "_:L" '((0 . "*TEXT"))))
    (progn
      (repeat (setq n (sslength sstext))
(acet-ui-status (strcat (itoa n) " Texts remaining.") "Status")
(command "_.delay" 0)
(setq ent (ssname sstext (setq n (1- n))))
(setq obj (vlax-ename->vla-object ent))
(setq txtstr (vla-get-textstring obj))
(setq typ (strcase (vla-get-objectname obj)))
(if (vl-string-search "ACDBTEXT" typ)
  (progn ;; TEXT is PLAIN TEXT
(setq widfac (vla-get-Scalefactor obj))
(cond ((and (>= widfac 0.96) (<= widfac 1.04)) (vla-put-StyleName obj "ArialStyle"))
       ((and (>= widfac 0.85) (< widfac 0.96)) (vla-put-StyleName obj "ArialNarrowBoldStyle"))
       ((and (>= widfac 0.75) (< widfac 0.85)) (vla-put-StyleName obj "ArialNarrowStyle"))
       (T (princ (strcat "\nWidth Factor is not in given range for text : " txtstr)))
)
(vla-put-Scalefactor obj 1)
(entupd ent)
  )
  (progn ;; Text is MTEXT
(setq txtstrUC (strcase txtstr))
(setq idx 1)
(setq div (chr 124))
(setq txtstrlist nil)
(setq errhap nil)
(setq oldidx 1)
(while (and (not errhap) (setq idx (vl-string-search "\\W" txtstrUC idx)))
   (if (or (= idx 1) (/= (substr txtstrUC (- idx 1) 1) "\\"))
     (progn (setq found nil)
    (setq add 2)
    (setq widfac "")
    (while (not found)
      (setq tmp1 (substr txtstrUC (+ idx add) 1))
      (if (or (equal tmp1 div) (equal tmp1 ";") (equal tmp1 "\\"))
(progn (setq found T))
(progn (setq add (1+ add)) (setq widfac (strcat widfac tmp1)))
      )
    )
    (setq widfac (atof widfac))
    (cond ((and (>= widfac 0.96) (<= widfac 1.04)) (setq found T) (setq substr2 (strcat "\\fArial" div "B0")))
  ((and (>= widfac 0.85) (< widfac 0.96))
   (setq found T)
   (setq substr2 (strcat "\\fArial Narrow" div "B1"))
  )
  ((and (>= widfac 0.75) (< widfac 0.85))
   (setq found T)
   (setq substr2 (strcat "\\fArial Narrow" div "B0"))
  )
  (T (setq errhap T) (setq found nil))
    )
    (if found
      (progn (setq temptxt (substr txtstrUC oldidx idx))
     (if (setq fontstrtidx (- (vl-string-search "\F" txtstrUC) 1))
       (progn (setq fontendidx (+ (vl-string-search (strcat div "B") temptxt) 4))
      (setq substr1 (substr txtstr 1 fontstrtidx))
      (setq substr3 (substr txtstr fontendidx (- idx fontendidx)))
      (setq substr4 "\\W1")
      (setq BalanceText (substr txtstr (+ idx add)))
      (setq txtstrlist (append txtstrlist (list (strcat substr1 substr2 substr3 substr4))))
       )
       (progn (setq errhap T)
      (princ (strcat "\nWidth Factor Found but corresponding Font Nout Found in text : " txtstr))
       )
     )
      )
      (progn (setq errhap T) (princ (strcat "\nWidth Factor is not in given range for text : " txtstr)))
    )
     )
   )
   (setq oldidx idx)
   (if (not errhap)
     (setq idx (+ idx 1))
     (setq idx (strlen txtstr))
   )
)
(setq strr "")
(if (and txtstrlist BalanceText)
   (progn (foreach xx txtstrlist (setq strr (strcat strr xx)))
  (setq strr (strcat strr BalanceText))
  (vla-put-textstring obj strr)
   )
)
(entupd ent)
  )
)
      )
    )
  )
  (acet-ui-status)
  (princ "\n")
  (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acActiveViewport)
  (setvar 'cmdecho 1)
  (princ)
)