muthu123 Posted June 7, 2010 Posted June 7, 2010 Dear all, Please correct the code at last line to update the width by "(vlax-put-property lay 'width (* 0.75 width_old) )". Please help. (defun style_change_to_avoid_bug_in_text_Selection (/ get->styleobj a width_old) (defun get->styleobj () (vla-get-textstyles (vla-get-ActiveDocument (vlax-get-acad-object)))) (vlax-for lay (get->styleobj) (Setq a (strcase (vlax-get-property lay 'FontFile))) (if (= (substr a (- (strlen a) 2) (strlen a)) "TTF") (progn (Setq name_Style (vlax-get-property lay 'Name)) (setq width_old (vlax-get-property lay 'width)) (vlax-put-property lay 'FontFile "romand.shx") (vlax-put-property lay 'width (* 0.75 width_old) ) ;;;(vlax-put-property lay 'width (rtos (* 0.75 width_old) 2 2)) ) ) ) (command "regen") ) Quote
Lee Mac Posted June 7, 2010 Posted June 7, 2010 It seems to work for me: (defun test ( / a name_style width_old) (vlax-for sty (vla-get-textstyles (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq a (strcase (vlax-get-property sty 'FontFile))) (if (eq (substr a (- (strlen a) 2)) "TTF") (progn (setq name_Style (vlax-get-property sty 'Name)) (setq width_old (vlax-get-property sty 'width)) (vlax-put-property sty 'FontFile "romand.shx") (vlax-put-property sty 'width (* 0.75 width_old)) ) ) ) (vla-regen doc acActiveViewport) (princ) ) Quote
muthu123 Posted June 7, 2010 Author Posted June 7, 2010 It seems to work for me: (defun test ( / a name_style width_old) (vlax-for sty (vla-get-textstyles (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq a (strcase (vlax-get-property sty 'FontFile))) (if (eq (substr a (- (strlen a) 2)) "TTF") (progn (setq name_Style (vlax-get-property sty 'Name)) (setq width_old (vlax-get-property sty 'width)) (vlax-put-property sty 'FontFile "romand.shx") (vlax-put-property sty 'width (* 0.75 width_old)) ) ) ) (vla-regen doc acActiveViewport) (princ) ) Thank you lee for your modification in my code. I want this in the following code also. Please help and do you have anyother logic to achieve this task? (defun style_change (/ a name_style width_old) (vlax-for sty (vla-get-textstyles (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq a (strcase (vlax-get-property sty 'FontFile))) (if (eq (substr a (- (strlen a) 2)) "TTF") (progn (setq name_Style (vlax-get-property sty 'Name)) (setq width_old (vlax-get-property sty 'width)) (vlax-put-property sty 'FontFile "romand.shx") (Setq sset (ssget "x" (list (cons 7 name_Style)))) (Setq #k 0) (repeat (sslength sset) (Setq ename (ssname sset #k)) (Setq vlobj (vlax-ename->vla-object ename)) (if (vlax-property-available-p vlobj 'width) (vla-put-width vlobj (* 0.75 width_old)) (vla-put-scalefactor vlobj (* 0.75 width_old)) ) (Setq #k (1+ #k)) ) ) ) ) (vla-regen doc acActiveViewport) (princ) ) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.