header image
Nieuws

www.CADToppers.com bestaat 5 jaar!

Recente berichten

Pagina's: [1] 2 3 ... 10
1
CAD 2017 / Sheet Set Manager
« Laatste bericht door CADTopper_ADMIN Gepost op 10 januari 2018, 10:17:32 »
Goede morgen CADToppers,

Even een vraag over de SSM....
Ik zou het fijn vinden, als ik de SSM open, dat ik dan een ingeklapte structuur heb.
Dit is nu niet het geval, is daar een instelling voor?

Gr. Richard
2
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door CADTopper_ADMIN Gepost op 4 januari 2018, 11:32:19 »
roy_043,

 CADTN

Het werkt prima, alle text stylen zijn nu uit de tekening.
3
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door roy_043 Gepost op 4 januari 2018, 11:28:17 »
Het comando is 'ChangeTextStyle'.
Als het niet werkt geef dan meer info over eventuele foutmeldingen.
4
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door CADTopper_ADMIN Gepost op 4 januari 2018, 11:14:51 »
Jammer dat een deel van de conversatie niet te volgen is.
Hoi roy_043,
De conversatie ging alleen over het vertrouwelijke gebruiken van de verstuurde tekening, de gevonden problemen en oplossingen etc. zijn in verkorte vorm gemeld op de site, inclusief de aangepaste LISP


Dank voor je bijdrage.
Even checken voor de zekerheid, moet ik hiervan een LISP file maken, of moet ik er iets anders mee doen?
(Want als LISP krijg ik hem niet aan de praat  :-[ :-[ :-[ )
5
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door roy_043 Gepost op 3 januari 2018, 17:09:12 »
Jammer dat een deel van de conversatie niet te volgen is.
Hieronder mijn voorstel.
De code houdt geen rekening met allerlei overrides en mtext formatting.
; Auteur:       Roy Klein Gebbinck (www.b-k-g.nl)
; Gemaakt voor: https://www.cadtoppers.com/index.php?topic=536.15

(vl-load-com)

; (ChangeTextStyle_Other "NewStyle1")
(defun ChangeTextStyle_Other (stl)
  (if (tblobjname "style" stl)
    (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
      (if
        (and
          (= :vlax-false (vla-get-isxref blk))                     ; Skip xrefs.
          (not (wcmatch (strcase (vla-get-name blk)) "`*D*,`*T*")) ; Skip anonymous dimension and table blocks.
        )
        (vlax-for obj blk
          (cond
            (
              (vl-position
                (vla-get-objectname obj) ; Objectname check is required. The stylename property is not always a text style.
                '("AcDbAttributeDefinition" "AcDbMText" "AcDbText")
              )
              (vla-put-stylename obj stl)
            )
            (
              (and
                (vlax-property-available-p obj 'hasattributes)
                (= :vlax-true (vla-get-hasattributes obj))
              )
              (foreach att (vlax-invoke obj 'getattributes) ; Handle "AcDbAttribute" objects.
                (vla-put-stylename att stl)
              )
            )
          )
        )
      )
    )
  )
)

; (ChangeTextStyle_DimensionStyles "NewStyle1")
(defun ChangeTextStyle_DimensionStyles (stl / stlEnm dimElst)
  (if (setq stlEnm (tblobjname "style" stl))
    (progn
      (vlax-for dim (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
        (if (assoc 340 (setq dimElst (entget (vlax-vla-object->ename dim))))
          (entmod (subst (cons 340 stlEnm) (assoc 340 dimElst) dimElst))
        )
      )
      (setvar 'dimtxsty stl) ; Avoid override.
    )
  )
)

; (ChangeTextStyle_TableStyles "NewStyle1")
(defun ChangeTextStyle_TableStyles (stl / enm elst)
  (if (tblobjname "style" stl)
    (foreach sub (dictsearch (namedobjdict) "ACAD_TABLESTYLE")
      (if (= 350 (car sub))
        (entmod
          (mapcar
            (function (lambda (sub) (if (= 7 (car sub)) (cons 7 stl) sub)))
            (entget (cdr sub))
          )
        )
      )
    )
  )
)

(defun c:ChangeTextStyle ( / doc stl)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq stl (getstring T "\nEnter new text style: "))
      (or
        (tblobjname "style" stl)
        (prompt "\nError: text style does not exist ")
      )
    )
    (progn
      (ChangeTextStyle_DimensionStyles stl)
      (ChangeTextStyle_TableStyles stl)
      (ChangeTextStyle_Other stl)
      (vla-regen doc acallviewports)
    )
  )
  (vla-endundomark doc)
  (princ)
)
6
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door DannyNL Gepost op 3 januari 2018, 15:00:02 »
Zoals Richard al aangaf waren ondanks de aanpassingen de oude textstyles niet te purgen. Alleen met wat extreme maatregelen, zoals het verwijderen van Dictionaries en copy-paste naar een lege tekening was dit voor elkaar te krijgen, maar dit geeft weer een risico dat je teveel onderhuids verwijderd wat mogelijk door andere applicaties gebruikt wordt.

Voor degene die geïnteresseerd is in de aangepaste code, zie hieronder. De dimension styles worden hiermee ook allemaal aangepast naar de opgegeven textstyle.

(defun c:Test (/ T_NewTextStyle T_Doc T_Style T_Dim)
   (if
      (and
         (/= (setq T_NewTextStyle (getstring "\nNieuwe tekststijl: ")) "")
         (tblsearch "STYLE" T_NewTextStyle)
      )
      (progn
         (setq T_Doc (vla-get-ActiveDocument (vlax-get-acad-object)))
         (vla-StartUndoMark T_Doc)
         (vlax-for T_Layout (vla-get-Layouts T_Doc)
            (ChangeTextStyle (vla-get-Block T_Layout) T_NewTextStyle)
         )
         (vlax-for T_Block (vla-get-Blocks T_Doc)
            (ChangeTextStyle T_Block T_NewTextStyle)
         )         
         (setq T_Style (tblobjname "STYLE" T_NewTextStyle))         
         (while (setq T_Dim (tblnext "DIMSTYLE" (not T_Dim)))
            (setq T_List (entget (tblobjname "DIMSTYLE" (cdr (assoc 2 T_Dim)))))
            (entmod (subst (cons 340 T_Style) (assoc 340 T_List) T_List))
         )
         (setvar "DIMTXSTY" T_NewTextStyle)
         (vla-EndUndoMark T_Doc)
         (vla-Regen T_Doc acAllViewports)
         (vlax-release-object T_Doc)
      )
      (princ "\n ** Tekststijl bestaat niet!")
   )
   (princ)
)

(defun ChangeTextStyle (CTS_Collection CTS_TextStyle)
   (vlax-for CTS_Object CTS_Collection
      (if
         (vlax-property-available-p CTS_Object 'StyleName)
         (vla-put-StyleName CTS_Object CTS_TextStyle)
      )
   )
)
7
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door CADTopper_ADMIN Gepost op 3 januari 2018, 14:46:54 »
Via de mail heb ik even contact gehad met Danny.
Hij heeft de LISP routine nog wat aangepast.
Desondanks blijven er sommige tekst stylen aanwezig.
Dit zijn waarschijnlijk proxy - objecten, die uit andere applicaties komen.
Met kunst en vlieg werk zijn deze wel uit de tekening te halen, maar voor nu is het een kwestie van accepteren dat dit soort dingen nou eenmaal voorkomen.

8
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door CADTopper_ADMIN Gepost op 3 januari 2018, 13:14:04 »
Ik heb je via mijn Gmail de tekening gestuurd.
9
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door DannyNL Gepost op 3 januari 2018, 13:06:18 »
Natuurlijk, geen probleem.
Is altijd makkelijker testen met een voorbeeld :)
10
CAD 2017 / Re: Tekststyle --> Progje gezocht!
« Laatste bericht door CADTopper_ADMIN Gepost op 3 januari 2018, 12:51:50 »
Danny,

Alvast bedankt voor je inspanningen!
Mag ik je anders een test tekening sturen, waarin stylen zitten die allemaal naar Standard toe moeten?
Pagina's: [1] 2 3 ... 10