wijzigen van de textstyle in blokken

[Manu]

Schematische tekeningen bevatten veelal erg veel blokken (symbolen) waar een tekst aan verbonden is (louter text, géén attributes).
De inhoud vandie blokken zijn dan nog meestal in verschillende layers en/of kleuren opgemaakt...
Ik vond reeds een handige lisp die ervoor zorgt dat de inhoud van een geselecteerde blok automatisch wijzigt naar het 'current layer'..
Echter blijf ik zitten met een aantal textstyles die ik liever niet heb...
Vandaar mijn vraag :

Kent iemand een lisproutine die alle tekst in alle blokken wijzigt naar de standaard textstyle..?

ben benieuwd.. 

Ps : voor Attributes bestaat de lisp al, voor text vond ik hem nog niet..

groeten,

Manu

[HofCAD]

Beste Manu,

Met onderstaand programma kun je teksten en attributen van tekststijl laten veranderen.

Code Selecteer Uitklappen


(defun C:BSTYLE (/ nent edata TxtStyl)
   (setq nent   (nentsel
"\nPick een entiteit binnen een block om de tekststijl te veranderen: "
         )
edata (entget (car nent))
   )
   (setq TxtStyl "")
   (while (not (tblsearch "STYLE" TxtStyl))
      (initget 1)
      (setq TxtStyl
     (getstring
        "\nNaam van een bestaande tekststijl die U wilt toepassen: "
     )
      )
   )
   (entmod
      (subst (cons 7 TxtStyl)
     (assoc 7 edata)
     edata
      )
   )
   (command "REGEN")
   (princ)
)


Met vriendelijke groet,
HofCAD CSI

[HofCAD]

Kent iemand een lisproutine die alle tekst in alle blokken wijzigt naar de standaard textstyle..?
groeten, Manu

Beste Manu,

Misschien bedoel je wel het onderstaande?
Het werkt alleen goed voor niet geneste(ingesloten)  blocks.

Code Selecteer Uitklappen


(defun BSTYLET (BlkNaam TxtStyl / BlkTbl CurEnt EntLst)
(setq BlkTbl (tblobjname "BLOCK" BlkNaam)
           CurEnt (cdr (assoc -2 (entget BlkTbl)))
)
(while (setq CurEnt (entnext CurEnt))
   (setq EntLst (entget CurEnt))
                                  (if (or (= (cdr (assoc 0 EntLst)) "TEXT")
        (= (cdr (assoc 0 EntLst)) "MTEXT")
        (= (cdr (assoc 0 EntLst)) "ATTDEF")
)
     (entmod
      (subst
        (cons 7 TxtStyl)
        (assoc 7 EntLst)
        EntLst
      )
     )
   )
)
(entupd BlkTbl)
(command "REGEN")
(princ)
)


Het programma kun je bijv. als onderstaand aanroepen:

(setq BlkNaam "MijnBlockNaam" TxtStyl (getvar "TEXTSTYLE"))
(BSTYLET BlkNaam TxtStyl)

Met vriendelijke groet,

HofCAD CSI

PS Als je de verandering van de tekststijl ook wil doorvoeren bij de attributen
van de reeds geplaatste blocks, dan moet er een synchronisatie plaats vinden
met bijv. het commando ATTSYNC.

[HofCAD]

Beste Manu en geïnteresseerden,

Het programma BSTYLE verandert per element in een block de tekststijl.
Als je een block meerdere keren in je tekening is geplaatst, dan zal bij selectie
van een tekstelement in alle geplaatste block's het tekstelement van stijl veranderen.
Als je echter een attribuutelement selecteert, dan zal slechts  het geselecteerde element
van tekststijl veranderen.
Indien men het block opent in de blockeditor met het commando BEDIT (en controleert
met LIST of met PROPERTIES), dan zullen wel de geselecteerde tekstelementen van stijl
veranderd zijn en de attribuutdefinities zullen onveranderd zijn (Inplaats van BEDIT kan
men natuurlijk ook REFEDIT gebruiken).

Indien je het programma BSTYLET gebruikt, dan gebeurd er iets anders.
Stel je hebt een block met de naam MijnBlockNaam en je wilt dat alle teksten en
attributen de tekststijl Standard krijgen, dan typ je op de commandoregel in:
(BSTYLET "MijnBlockNaam" "Standard")
Als je wilt dat alle teksten en attribuutdefinities de actieve tekststijl krijgen dan typ je

(setq BlkNaam "MijnBlockNaam" TxtStyl (getvar "TEXTSTYLE"))
(BSTYLET BlkNaam TxtStyl)

of

(BSTYLET "MijnBlockNaam" (getvar "TEXTSTYLE"))

Men ziet bij alle teksten meteen de stijlverandering, maar niet bij de attribuutdefinities.
Om de attributen in de block references te synchroniseren, moet men het commando
ATTSYNC of in de dialoogbox van BATTMAN (Block Attribuut Manager) het juiste block
kiezen en daarna op de knop Sync klicken.
Pas daarna ziet men dat de attributen veranderd zijn in de block references.
Indien men het block opent in de blockeditor met het commando BEDIT (en controleert
met LIST of met PROPERTIES), dan zullen alle tekstelementen  en attribuutdefinities van
stijl veranderd zijn (Inplaats van BEDIT kan men natuurlijk ook REFEDIT gebruiken).

Met vriendelijke groet,
HofCAD CSI

PS1 Voor het gebruik van BEDIT tov REFEDIT is het onderwerp 'Blockeditor in AutoCAD 2007'
interessant.
Zie: http://www.cadsite.be/smf/index.php/topic,1315.0.html

PS2 Als de tekststijl verandering een font verandering impliceert, verandert men ook de
breedte van de letters.
Het zou dus goed zijn om in bovenstaande programma  een mogelijkheid van text width
verandering mogelijk te maken.

PS3 Het commando ATTSYNC is pas van AutoCAD 2002 beschikbaar, en wordt in het bovenstaande programma niet automatisch aangeroepen.
Het zou dus goed zijn als het synchroniseren van attributen automatisch zou verlopen.
Waarom ATTSYNC?
Zie http://www.autocadexchange.com/forum/list_messages/811
en http://www.autocadexchange.com/forum/list_messages/847

[HofCAD]

Schematische tekeningen bevatten veelal erg veel blokken (symbolen) waar een tekst aan verbonden is (louter text, géén attributes).
De inhoud vandie blokken zijn dan nog meestal in verschillende layers en/of kleuren opgemaakt...
Ik vond reeds een handige lisp die ervoor zorgt dat de inhoud van een geselecteerde blok automatisch wijzigt naar het 'current layer'..
Echter blijf ik zitten met een aantal textstyles die ik liever niet heb...
Vandaar mijn vraag :
Kent iemand een lisproutine die alle tekst in alle blokken wijzigt naar de standaard textstyle..?
ben benieuwd.. 
Ps : voor Attributes bestaat de lisp al, voor text vond ik hem nog niet..
groeten, Manu.

Beste Manu en geïnteresseerden,

Misschien is het onderstaande programma iets leuker dan het voorgaande.

Code Selecteer Uitklappen


;;;werkt vanaf AutoCAD 2000 en waarbij niet geneste(ingesloten) blocks worden bewerkt
(defun c:ChBlkTxt (/ InsLst TxtStyl cTxtstyl TxtWidth TxtHeight)
  (setq InsLst (entget (car (entsel "\nPlease choose an Block: "))))
  (while (/= (cdr (assoc 0 InsLst)) "INSERT")
    (setq InsLst (entget (car (entsel "\nWrong, choose an Block: "))))
  )
  (setq TxtStyl ""
cTxtstyl (getvar "TEXTSTYLE")
  )
  (while (not (tblsearch "STYLE" TxtStyl))
    (initget 1)
    (setq TxtStyl
   (getstring
     (strcat
       "\nNew style name for block text (default is current text style) <"
       cTxtstyl
       ">:"
     )
   )
    )
    (if (= TxtStyl "")
      (setq TxtStyl cTxtstyl)
    )
  )
  (initget 4)
  (setq
    TxtWidth (getreal
       "\nNew text width for block text(0 for no change)<0>: "
     )
  )
  (if (= TxtWidth nil)
    (setq TxtWidth 0)
  )
  (initget 4)
  (setq
    TxtHeight
     (getreal
       "\nNew text height for block text(0 for no change)<0>: "
     )
  )
  (if (= TxtHeight nil)
    (setq TxtHeight 0)
  )
  ($ChBlkTxt InsLst TxtStyl TxtWidth TxtHeight)
)
(defun $ChBlkTxt (InsLst TxtStyl TxtWidth TxtHeight / x edata)
  (setq
    x (cdr
(assoc -2 (cdr (tblsearch "BLOCK" (cdr (assoc 2 InsLst)))))
      )
  )
  (while x
    (if x
      (progn (setq edata (entget x))
     (if (or (= (cdr (assoc 0 edata)) "TEXT")
     (= (cdr (assoc 0 edata)) "MTEXT")
     (= (cdr (assoc 0 edata)) "ATTDEF")
)
       (progn
(if (/= TxtWidth 0)
   (setq edata (entmod
(subst (cons 41 TxtWidth)
(assoc 41 edata)
edata
)
       )
   )
)
(if (/= TxtHeight 0)
   (setq edata (entmod
(subst (cons 40 TxtHeight)
(assoc 40 edata)
edata
)
       )
   )
)
(setq edata (entmod
       (subst (cons 7 TxtStyl)
      (assoc 7 edata)
      edata
       )
     )
)
       )
     )
      )
    )
    (setq x (entnext x))
  )
  (if (getvar "DIMASSOC")
    (command "_ATTSYNC" "N" (cdr (assoc 2 InsLst)))
    ($attsync (cdr (assoc 2 InsLst)) TxtWidth TxtHeight TxtStyl)
  )
  (command "REGEN")
  (princ)
)
(defun $attsync (BlkName TxtWidth TxtHeight TxtStyl / ss1 i sh)
  (defun @attsync (sh / edata)
    (if (= (cdr (assoc 0 (entget sh))) "ATTRIB")
      (progn (setq edata (entget sh))
     (if (/= TxtWidth 0)
       (setq edata (entmod
     (subst (cons 41 TxtWidth)
    (assoc 41 edata)
    edata
     )
   )
       )
     )
     (if (/= TxtHeight 0)
       (setq edata (entmod
     (subst (cons 40 TxtHeight)
    (assoc 40 edata)
    edata
     )
   )
       )
     )
     (setq edata (entmod
   (subst (cons 7 TxtStyl)
  (assoc 7 edata)
  edata
   )
)
     )
     (entupd sh)
      )
    )
  )
  (setq ss1 nil
ss1 (ssget "X"
   (list '(0 . "INSERT") '(66 . 1) (cons 2 BlkName))
    )
  )
  (setq i 0)
  (repeat (sslength ss1)
    (setq sh (ssname ss1 i))
    (while (/= (cdr (assoc 0 (entget sh))) "SEQEND")
      (@attsync sh)
      (setq sh (entnext sh))
    )
    (setq i (1+ i))
  )
)
(print "ChBlkTxt loaded")


Met vriendelijke groet,
HofCAD CSI

PS1 Merk op dat men nu naast tekststijl verandering ook de breedte(width) en de hoogte(height)
kan veranderen, en dat er automatisch een synchronisatie plaatsvindt van de attributen.
Maar alle teksten (TEXT en MTEXT) en attributen krijgen dan dezelfde breedte en hoogte.

PS2 Wel even uitproberen of het wel werkt, want julie weten het: 'Ik ben blond'.

PS3 Bovenstaand programma heeft op 29/08-2006 een default tekststijl gekregen.

[Manu]

HofCad,

Blond of niet, je kennis van lisp blijft verbazend... de textstyle van de geselecteerde blok wordt moeiteloos aangepast naar wens.... HOERA!!
Echter, bij een blok waarbij de FONT van de Mtext is bepaald door het selecteren van de letterreeks werkt het niet..,
want autocad voegt aan die letterreeks een extra bepaling toe bv : {\Fstylus BT\b0\i0\c0\p34;test} die de FONT van de textstyle overschrijft..
en zo lijkt het alsof de lisp niet werkte..
Nu, ondanks dit kleine akkefietje is het een érg mooie lisp waar menig Cad-gebruiker (waaronder mezelf) veel baat aan heeft!!

héél erg bedankt HofCAD 

Manu

ps : julien, deze lisp verdient een hele mooie ereplaats bij de downloads... toch??

[HofCAD]

HofCad,

Blond of niet, je kennis van lisp blijft verbazend... de textstyle van de geselecteerde blok wordt moeiteloos aangepast naar wens.... HOERA!!
Echter, bij een blok waarbij de FONT van de Mtext is bepaald door het selecteren van de letterreeks werkt het niet..,
want autocad voegt aan die letterreeks een extra bepaling toe bv : {\Fstylus BT\b0\i0\c0\p34;test} die de FONT van de textstyle overschrijft..
en zo lijkt het alsof de lisp niet werkte..
Nu, ondanks dit kleine akkefietje is het een érg mooie lisp waar menig Cad-gebruiker (waaronder mezelf) veel baat aan heeft!!

héél erg bedankt HofCAD 


Manu

ps : julien, deze lisp verdient een hele mooie ereplaats bij de downloads... toch??

Manu,
Graag gedaan.

Met vriendelijke groet,
HofCAD CSI

Ps Ik moet bescheiden blijven, want straks maak ik weer een koe van een fout.
Dit is nu eenmaal een gegeven bij blonde mensen.

[julien]

ps : julien, deze lisp verdient een hele mooie ereplaats bij de downloads... toch??

Ik zal eerst eens beginnen met alles goed door te lezen zodat ik zie wat deze lisp doet. 

[Joop]

Knap gedaan HofCAD!

[HofCAD]

.......
Echter blijf ik zitten met een aantal textstyles die ik liever niet heb...
Vandaar mijn vraag :
Kent iemand een lisproutine die alle tekst in alle blokken wijzigt naar de standaard textstyle..?
ben benieuwd..  
......
groeten, Manu

Beste Manu en geinteresseerden,

Een variant in Vlisp, die alle blocks van tekststijl, tekstbreedte en hoogte kan veranderen,
zal misschien voor  U ook interessant zijn.

Code Selecteer Uitklappen


(defun c:ChBtextA (/ Doc blk Ent cTxtstyl TxtStyl TxtHeight TxtWidth)
 (vl-load-com)
 (setq Doc (vla-get-activedocument (vlax-get-acad-object))
TxtStyl ""
cTxtstyl (getvar "TEXTSTYLE")
 )
 (while (not (tblsearch "STYLE" TxtStyl))
   (initget 1)
   (setq TxtStyl
  (getstring
    (strcat
      "\nNew style name for block text (default is current text style) <"
      cTxtstyl
      ">:"
    )
  )
   )
   (if (= TxtStyl "")
     (setq TxtStyl cTxtstyl)
   )
 )
 (initget 4)
 (setq
   TxtWidth (getreal
      "\nNew text width for block text(0 for no change)<0>: "
    )
 )
 (if (= TxtWidth nil)
   (setq TxtWidth 0)
 )
 (initget 4)
 (setq
   TxtHeight
    (getreal
      "\nNew text height for block text(0 for no change)<0>: "
    )
 )
 (if (= TxtHeight nil)
   (setq TxtHeight 0)
 )
 (vla-startundomark Doc)
 (vlax-for Blk (vla-get-blocks Doc)
   (if (and (not (wcmatch (strcase (vla-get-name Blk) t) "*_Space*"))
    (/= (substr (vla-get-name Blk) 1 1) "*")
)
     (progn
(vlax-for ent Blk
 (if (vlax-property-available-p ent 'stylename t)
   (progn
     (vlax-put ent 'Stylename TxtStyl)
     (if (/= TxtWidth 0)
(vlax-put ent 'ScaleFactor TxtWidth)
     )
     (if (/= TxtHeight 0)
(vlax-put ent 'Height TxtHeight)
     )
   )
 )
)
     )
   )
 )
 (foreach Blk
  (mapcar
    'vlax-ename->vla-object
    (vl-remove-if
      'listp
      (mapcar 'cadr
      (ssnamex (ssget "_X" '((0 . "INSERT") (66 . 1))))
      )
    )
  )
   (foreach ent (vlax-safearray->list
  (vlax-variant-value (vla-getattributes Blk))
)
     (vl-catch-all-apply
'(lambda () (vlax-put ent 'Stylename TxtStyl))
     )
     (vl-catch-all-apply
'(lambda () (vlax-put ent 'ScaleFactor TxtWidth))
     )
     (vl-catch-all-apply
'(lambda () (vlax-put ent 'Height TxtHeight))
     )
   )
 )
 (vla-regen Doc acactiveviewport)
 (vla-endundomark Doc)
 (princ)
)


Met vriendelijke groet,
HofCAD CSI

PS Wel even uitproberen of het wel werkt, want julie weten het: 'Ik ben blond'.  

[bart]

http://www.users.qwest.net/~sdoman/

Hier kan je een lisp + dcl met de naam stripmtext vinden die mtext helemaal bij layer krijgt
werkt (nog niet) in blocken maar is wel heel handig voor het aanpasssen van harde instellingen in de mtext

[Joop]

HofCAD,

Ik vind dit een mooi staaltje van programmeren in Visual Lisp met gebruikmaking van object georienteerd programmeren, zoals dat ook in VBA gebeurt.

Joop