make layers unpurge

cadtools@gmail.com · ma 04 07 2016, 22:19:53

Ik wil een aantal lagen (genaamd "1" "2" "3") unpurgeble maken.
Maar ik kom er niet uit hoe ik deze lijst prts aanpas
Ik zou het wel erg handig vinden om mijn vaste lagen te kunnen vasthouden..
BVD

(setq ptrs (cons (cons 340 (tblobjname "LAYER" name)) ptrs))
hoe maak ik een goede layer lijst aan voor prts?

Merci beaucoup

Code Selecteer



;; gc:GetExtDict (gile)
;; Retourne le dictionnaire d'extension de l'entitÃ© (ou nil)
;;
;; Argument : ent (ENAME)
(defun gc:GetExtDict (ent)
  (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget ent)))
)

;; gc:GetOrCreateExtDict (gile)
;; Retourne le dictionnaire d'extension de l'entitÃ©
;; Le dictionnaire est crÃ©Ã© s'il n'existe pas
;;
;; Argument : ent (ENAME)
(defun gc:GetOrCreateExtDict (ent / dict)
  (cond
    ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget ent))))
    ((setq dict	(entmakex
		  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
		)
     )
     (entmod (append (entget ent)
		     (list '(102 . "{ACAD_XDICTIONARY")
			   (cons 360 dict)
			   '(102 . "}")
		     )
	     )
     )
     dict
    )
  )
)

;; gc:SetXrecData
;; Retourne le ENAME du xrecord auquel sont affectÃ©es mes donnÃ©es
;;
;; Arguments
;; dict : ENAME du dictionnaire parent
;; key : nom du Xrecord
;; data : liste de paires pointÃ©es contenant les donnÃ©es
(defun gc:SetXrecData (dict key data / xrec)
  (if (snvalid key)
    (progn
      (and (setq xrec (dictsearch dict key))
	   (entdel (cdr (assoc -1 xrec)))
      )
      (dictadd
	dict
	key
	(entmakex
	  (append
	    (list '(0 . "XRECORD")
		  '(100 . "AcDbXrecord")
	    )
	    data
	  )
	)
      )
    )
  )
)

;;----------------------------------------------------;;
;;                      Commands                      ;;
;;----------------------------------------------------;;

;; SETALLLAYERSUNPURGEABLE command to set all layers unpurgeable
(defun c:Unpurg (/ lay name ptrs tbl)
  (while (setq lay (tblnext "LAYER" (not lay)))
    (if	(/= (setq name (cdr (assoc 2 lay))) "0")
      (setq ptrs (cons (cons 340 (tblobjname "LAYER" name)) ptrs))
    )
  )
  (setq tbl (cdr (assoc 330 (entget (tblobjname "LAYER" "0")))))
  (gc:SetXrecData
    (gc:GetOrCreateExtDict tbl)
    "LAYER_UNPURGE"
    ptrs
  )
  (princ)
)

;; RESETALLLAYERSPURGEABLE command to reset all layers purgeable
(defun c:Repurg(/ tbl xdict)
  (setq tbl (cdr (assoc 330 (entget (tblobjname "LAYER" "0")))))
  (and
    (setq xdict (gc:GetExtDict tbl))
    (dictremove xdict "LAYER_UNPURGE")
  )
  (princ)
)

roy_043 · vr 08 07 2016, 13:28:01

Code Selecteer

(defun c:Unpurg (/ enm lst ptrs)
  (setq lst '("1" "2" "3")) ; Laagnamen.
  (foreach nme lst
    (if (setq enm (tblobjname "LAYER" nme))
      (setq ptrs (cons (cons 340 enm) ptrs))
    )
  )
  (gc:SetXrecData
    (gc:GetOrCreateExtDict (cdr (assoc 330 (entget (tblobjname "LAYER" "0")))))
    "LAYER_UNPURGE"
    ptrs
  )
  (princ)
)

Voor BricsCAD moet GetOrCreateExtDict overigens aangepast worden (volgorde append):

Code Selecteer

(defun gc:GetOrCreateExtDict (ent / dict)
  (cond
    ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget ent))))
    ((setq dict (entmakex
                  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
                )
     )
     (entmod (append (list '(102 . "{ACAD_XDICTIONARY")
                           (cons 360 dict)
                           '(102 . "}")
                     )
                     (entget ent)
             )
     )
     dict
    )
  )
)

cadtools@gmail.com · vr 08 07 2016, 16:00:12

Respect! Ziet er zoooo makkelijk uit.
Dat scheelt weer een flink aantal onnodige handelingen voor onnodig purgen en opnieuw aanmaken layers.
Super bedankt Roy!

EddyBeerke · do 14 07 2016, 09:29:58

Misschien voor de gebruikers die juist die tekening ontvangt...
Hoe kun je die lagen toch purgen?
Er zijn nog steeds opdrachtgevers die graag overbodige layers e.d. niet in de dwg willen zien.

cadtools@gmail.com · vr 15 07 2016, 11:37:56

ja dat kan wel maar de wereld vergaat niet met wat layer defs. meer of minder.
Alleen layer fanatici die daar moeilijk over doen. Kwestie van betere filters gebruiken..
Command:
Unpurgeall
Ik ga hem posten voor je Eddy

roy_043 · vr 15 07 2016, 11:55:47

... De code in de OP bevat de functie c:Repurg...

cadtools@gmail.com · vr 15 07 2016, 15:19:57

Hij is van GileCAD. een fransman

roy_043 · vr 15 07 2016, 23:39:15

Voor alle duidelijkheid:
Mijn vorige bericht is niet gericht aan het adres van de maker, hoewel een bronvermelding altijd welkom is. Mijn kritiek is gericht aan Eddy, en ook Hans. Heren: lees de code en de toelichting eens goed door! De functie c:Repurg is het antwoord op Eddy's vraag.

cadtools@gmail.com · ma 18 07 2016, 20:41:06

Bedankt voor toelichting. Dat had ik er eerder duidelijker bij morgen vermelden.
De orginele code maakte ALLE layers unpurgeble. Dat vind ik niet wenselijk en handig.

EddyBeerke · di 19 07 2016, 11:51:17

Citaat van: roy_043 op vr 15 07 2016, 23:39:15
Voor alle duidelijkheid:
Mijn vorige bericht is niet gericht aan het adres van de maker, hoewel een bronvermelding altijd welkom is. Mijn kritiek is gericht aan Eddy, en ook Hans. Heren: lees de code en de toelichting eens goed door! De functie c:Repurg is het antwoord op Eddy's vraag.

Dan bij deze de bal terug bij de criticus:
Wat als die "layer fanatici die daar moeilijk over doen" nu niet lid van deze site zijn, en dus niet deze lisp hebben?
(Zoals opdrachtgevers die geen rommel in de dwg willen) Hoe staarten ze dan het commando "REPURGE"?

cadtools@gmail.com · di 19 07 2016, 13:06:30

Dat is per discipline natuurlijk verschillend maar voor 'constructies' (NLCS) ken ik eigenlijk maar Ã©Ã©n opdrachtgever die kritisch is voor ontvangst DWG. De rest snapt het niet, maakt het niets uit of daarvoor geldt dat er NLCS als standaard is achterhaald.. Pogingen tot standaardisering lijken bij voorbaat kansloos..

Bedoel je deze niet, om ze weer purge-baar te maken?

Code Selecteer



;; RESETALLLAYERSPURGEABLE command to reset all layers purgeable
(defun c:Repurg(/ tbl xdict)
  (setq tbl (cdr (assoc 330 (entget (tblobjname "LAYER" "0")))))
  (and
    (setq xdict (gc:GetExtDict tbl))
    (dictremove xdict "LAYER_UNPURGE")
  )
  (princ)
)

roy_043 · di 19 07 2016, 17:32:47

Citaat van: EddyBeerke op di 19 07 2016, 11:51:17
Dan bij deze de bal terug bij de criticus:
Wat als die "layer fanatici die daar moeilijk over doen" nu niet lid van deze site zijn, en dus niet deze lisp hebben?
(Zoals opdrachtgevers die geen rommel in de dwg willen) Hoe staarten ze dan het commando "REPURGE"?

Daar heb je een punt Eddy. Ik hoop dat je het ermee eens bent dat ook ik een punt heb met mijn vorige opmerking.

bart · wo 20 07 2016, 08:05:08

dan maken ze even een wblock van de tekening en inserten die vervolgens die vervolgens in een lege.

Als de laag niet in gebruik is ben je hem dan kwijt

roy_043 · wo 20 07 2016, 10:51:53

Citaat van: bart op wo 20 07 2016, 08:05:08
dan maken ze even een wblock van de tekening en inserten die vervolgens die vervolgens in een lege.

Als de laag niet in gebruik is ben je hem dan kwijt

Vreemd dat de 3 andere deelnemers aan deze topic, waaronder deze 'criticus'

, dat niet getest hebben...

cadtools@gmail.com · wo 20 07 2016, 12:15:01

Nadeel van wblocken is wel dat je dan alles in paperspace kwijt bent.
Of je moet weet meer gaan overhevelen. Unpurge maakt gebruik van XDATA die wordt weggeschreven op een element, in dit geval object 'laag'. Eerlijk gezegd ben ik niet zo thuis in deze materie. Hoe kun je de tag die wordt meegegeven aan de layer, nl. 'UNPURGE' nu eigenlijk makkelijk zien? Code deel dat het wegschrijft.

Code Selecteer


  (gc:SetXrecData
    (gc:GetOrCreateExtDict tbl)
    "LAYER_UNPURGE"                 ; XDATA, zien zien met functie..?

https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-Core/files/GUID-F0299B36-232F-446E-9F81-98F300B36991-htm.html