LiSP to change text style font file definitions?

[Anonymous]

We are changing our standard from romans.shx to Arial.ttf
My question is often times I get drawings with a half a dozen different text
style definitions.
Rather then clean up everything and look at everything I was wondering if
there was an efficient way
to read all the text style definitions. If the font file is romans.shx or
simplex.shx or txt.shx to change the
definition to use Arial.ttf

[Anonymous]

Just step through the style collection (is text style collection) and change
the 'FontFile' property as necessary.

--

Tim
"A blind man lets nothing block his vision."


"Dave Allen" wrote in message
news:5771705@discussion.autodesk.com...
We are changing our standard from romans.shx to Arial.ttf
My question is often times I get drawings with a half a dozen different text
style definitions.
Rather then clean up everything and look at everything I was wondering if
there was an efficient way
to read all the text style definitions. If the font file is romans.shx or
simplex.shx or txt.shx to change the
definition to use Arial.ttf

[Anonymous]

sorry that is beyond my hack-code capabilities


"T.Willey" wrote in message news:5771749@discussion.autodesk.com...
Just step through the style collection (is text style collection) and change
the 'FontFile' property as necessary.

--

Tim
"A blind man lets nothing block his vision."


"Dave Allen" wrote in message
news:5771705@discussion.autodesk.com...
We are changing our standard from romans.shx to Arial.ttf
My question is often times I get drawings with a half a dozen different text
style definitions.
Rather then clean up everything and look at everything I was wondering if
there was an efficient way
to read all the text style definitions. If the font file is romans.shx or
simplex.shx or txt.shx to change the
definition to use Arial.ttf

[Anonymous]

Try this

(vl-load-com)

(defun c:updateTextstyles (/ new)
(setq new (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf"))
(vlax-map-collection
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)))
'(lambda (x / font)
(setq font (strcase (vla-get-fontfile x)))
(if (wcmatch font "ROMANS.SHX,SIMPLEX.SHX,TXT.SHX")
(vla-put-fontfile x new)))
)
(princ)
)

--
Autodesk Discussion Group Facilitator


"Dave Allen" wrote in message
news:5771775@discussion.autodesk.com...
sorry that is beyond my hack-code capabilities

[piyush.parihar24]

This LISP is not working in my case...

Command do run but furthur steps are not asked after performing the action..

Please Provide solution

[patrick_35]

Hi

It's work for me. Use REGEN

@+

[piyush.parihar24]

Hi

AutoCAD has taken the command but further it's not executing the same...even after REGEN

[patrick_35]

Another solution
Replace all texts in simplex, romans, etc... in arial

(defun c:arial(/ chg doc ele obj)
  (defun chg(obj)
    (and (vlax-property-available-p obj 'stylename)
	 (vl-position (strcase (vla-get-stylename obj)) '("ROMANS" "SIMPLEX" "TXT"))
      (vla-put-stylename obj "Arial")
    )
  )

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (vlax-for ele (vla-get-blocks doc)
    (vlax-for obj ele
      (if (eq (vla-get-objectname obj) "AcDbBlockReference")
	(mapcar 'chg (vlax-invoke obj 'getattributes))
	(chg obj)
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

@+

[piyush.parihar24]

Hi 

same error coming ...to be specific i want to convert all text styles in drawing to romans.shx

[m_badran]

Hi,try this.

(defun c:demo	(/ DOC FNTPTH STY )
  (vl-load-com)
  (setq	doc (vla-get-activedocument
	      (vlax-get-acad-object)
	    )
  )
  (setq FntPth (findfile "C:\\Windows\\Fonts\\arial.ttf"))
  (setq sty (vla-get-textstyles doc))
  (vlax-for s sty
    (vla-put-fontfile s FntPth)
  )
  (if (ssget "x" '((0 . "text")))
    (vlax-for n	(vla-get-activeselectionset doc)
    )
  )
  (vla-regen doc acAllViewports)
  (princ)
)

[piyush.parihar24]

cool !!!..it's working....but i want to convert all text styles to "ROMANS.shx"...i made small changes in your lsp but doesn't work.Could you do that ?...I'm waiting

[piyush.parihar24]

Hi,

cool !!!..it's working....but i want to convert all text styles to "ROMANS.shx"...I made small changes in your lsp but doesn't work.Could you do that ?...I'm waiting...

[m_badran]

Ok,try this.

(defun c:demo	(/ DOC FNTPTH STY )
  (vl-load-com)
  (setq	doc (vla-get-activedocument
	      (vlax-get-acad-object)
	    )
  )
  (setq FntPth (findfile "ROMANS.shx"))
  (setq sty (vla-get-textstyles doc))
  (vlax-for s sty
    (vla-put-fontfile s FntPth)
  )
  (if (ssget "x" '((0 . "text")))
    (vlax-for n	(vla-get-activeselectionset doc)
    )
  )
  (vla-regen doc acAllViewports)
  (princ)
)

[piyush.parihar24]

Great work mostafabadran it is working. Thank you So much for your help.

[m_badran]

Your welcome.

[kpblc2000]

Another one version (uses "romans.shx" firstly from AutoCAD support paths and then from Windows\Fonts directory. Changes ttf to shx and removes BigFont data:
[code](vl-load-com)

(defun c:ch-txtst (/ _kpblc-conv-string-to-list adoc file path)
(defun _kpblc-conv-string-to-list (string separator / i)
(cond ((= string "") nil)
((= separator "") (list string))
((vl-string-search separator string)
((lambda (/ pos res)
(while (setq pos (vl-string-search separator string))
(setq res (cons (substr string 1 pos) res)
string (substr string (+ (strlen separator) 1 pos))
) ;_ end of setq
) ;_ end of while
(reverse (cons string res))
) ;_ end of lambda
)
)
((wcmatch (strcase string) (strcat "*" (strcase separator) "*"))
((lambda (/ pos res _str prev)
(setq pos 1
prev 1
_str (substr string pos)
) ;_ end of setq
(while (<= pos (1+ (- (strlen string) (strlen separator))))
(if (wcmatch (strcase (substr string pos (strlen separator))) (strcase separator))
(setq res (cons (substr string 1 (1- pos)) res)
string (substr string (+ (strlen separator) pos))
pos 0
) ;_ end of setq
) ;_ end of if
(setq pos (1+ pos))
) ;_ end of while
(if (< (strlen string) (strlen separator))
(setq res (cons string res))
) ;_ end of if
(if (or (not res) (= _str string))
(setq res (list string))
(reverse res)
) ;_ end of if
) ;_ end of lambda
)
)
(t (list string))
) ;_ end of cond
) ;_ end of defun
(if (setq file "romans.shx"
file (if (and (setq path (car (vl-remove-if-not (function (lambda (x) (vl-directory-files x file)))
(vl-remove "" (_kpblc-conv-string-to-list (getenv "ACAD") ";"))
) ;_ end of vl-remove-if-not
) ;_ end of car
) ;_ end of setq
(setq path (findfile (strcat (vl-string-right-trim "\\" path) "\\" file)))
) ;_ end of and
path
(findfile file)
) ;_ end of if
) ;_ end of setq
(progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for item (vla-get-textstyles adoc)
(setq item (entget (vlax-vla-object->ename item)))
(entmod (subst (cons 3 (strcat (vl-filename-base file) (vl-filename-extension file)))
(assoc 3 item)
(subst (cons 4 "") (assoc 4 item) item)
) ;_ end of subst
) ;_ end of entmod
(entupd (cdr (assoc -1 item)))
) ;_ end of vlax-for
(vla-regen adoc acallviewports)
(vla-endundomark adoc)
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun[/code]

[piyush.parihar24]

What makes it different from what previously given solution?

[kpblc2000]

I told - romas.shx could be placed at c:\windows\fonts, not at ACAD support folders. Secondary - style could be used BigFont. My code makes BigFont off. You can use your code or any other versions - noone can say to you what to do and how to do it 😉

[piyush.parihar24]

Ok Got It..
Thanks A ton...

[piyush.parihar24]

I am sorry to ask this question in his forum. Burt will be great help if anyone can solve it.
I know how to customize the toolbar but only for AutoCAD basic command which are inbuilt.
If i want to make LISP Developed command in toolbar how will i make?