setbylayerreverse en ApplytoBlockObjects OPGELOST

[Fly]

Hoi,

Ik zou graag 2 LISP's willen combineren van acad man Lee Mac, maar heb geen idee hoe hieraan te beginnen.
Graag had ik alle objecten in mijn block de eigenschap willen geven van de layer. Dus als het object in de block op een layer staat met kleur 220, krijgt het object kleur 220.
Hier alvast de lisp van Lee Mac

SetByLayerReverse:
(defun c:SetByLayerReverse (/ *error* adoc layer obj en ss i )
 
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ))
 
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (if (setq ss (ssget))
    (repeat (setq i (sslength ss))
      (setq en (ssname ss (setq i (1- i)))
       obj (vlax-ename->vla-object en)
       layer (vla-get-layer obj))
     
      (if (not (assoc 62 (entget en)))
   (vla-put-color obj (cdr (assoc 62 (tblsearch "layer" layer)))))
     
      (if (not (assoc 6 (entget en)))
   (vla-put-linetype obj (cdr (assoc 6 (tblsearch "layer" layer)))))
     
      (if (not (assoc 370 (entget en)))
   (vla-put-lineweight obj (cond ((cdr (assoc 370 (tblsearch "layer" layer))))
                  (-3))))))
  (vla-endundomark adoc)
  (princ)
)


applytoblockobjects:
; Apply to Block Objects  -  Lee Mac
;; Evaluates a supplied function on all objects in a block definition.
;; Arguments:
;; blks - VLA Block Collection in which block resides
;; name - Block name
;; func - function to apply to all objects in block
;; Returns a list of results of evaluating the function, else nil.

(defun LM:ApplytoBlockObjects ( blks name func / def result )
    (setq func (eval func))
    (if (not (vl-catch-all-error-p (setq def (vl-catch-all-apply 'vla-item (list blks name)))))
        (vlax-for obj def (setq result (cons (func obj) result)))
    )
    (reverse result)
)

Alvast bedankt!

Fly

[EddyBeerke]

Wat is je doel hiermee?

[Fly]

Hoi,

De bedoeling is dat ik van een tekening met 100+ lagen met vele Xref's naar een tekening ga met 6 hoofdlagen.
Hiervan wordt dan een "gelayerede" PDF gemaakt waarbij ik de 6 lagen op en af kan zetten.
De Xref's worden in de tekening gebind en worden dus een block, via layermanager verdeel ik al deze 100+ layers naar de 6 hoofdlagen. Het probleem is dat al de meeste objecten die in de block (dus ex-xref) by layer staan de kleur krijgen van 1 van de 6 hoofdagen, en dat mag dus niet. Deze objecten moeten dus eerst naar by color gezet worden. Dit kan via de LISP SetByLayerReverse. Het is nogal omslachtig om deze lisp telkens uit te voeren in de blockeditor. LISP applytoblockobjects kan dit proces versnellen. Mijn vraag is eigenlijk: is er een manier om de SetByLayerReverse LISP uit als batch te voeren op al  de block's in de tekening.

Alvast bedankt!

Fly

[roy_043]

@Fly: je spreekt alleen over de color, maar de voorbeeldcode verandert ook de linetype en lineweight properties.

Maar probeer dit eens:

Code Selecteer Uitklappen

(defun c:InheritLayerProps ( / doc lst)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (vlax-for obj (vla-get-layers doc)
    (setq lst
      (cons
        (list
          (vla-get-name obj)
          (cons 'color (vlax-get obj 'color))
          (cons 'linetype (vlax-get obj 'linetype))
          (cons 'lineweight (vlax-get obj 'lineweight))
          ; Material?
          ; Transparency?
          ; LinetypeScale?
        )
        lst
      )
    )
  )
  (vlax-for blk (vla-get-blocks doc)
    (if
      (and
        (= :vlax-false (vla-get-islayout blk))
        (= :vlax-false (vla-get-isxref blk))
        (= :vlax-false (vla-get-isdynamicblock blk))
        (/= "*" (substr (vla-get-name blk) 1 1))
      )
      (vlax-for obj blk
        (foreach sub (cdr (assoc (vla-get-layer obj) lst))
          (vlax-put obj (car sub) (cdr sub))
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

[Fly]

@roy_043, inderdaad al de laageigenschappen moeten naar het object komen, tenzij er al eigenschappen zijn toegekend.

grts

[roy_043]

Code Selecteer Uitklappen

(defun c:InheritLayerProps ( / doc lst)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (vlax-for obj (vla-get-layers doc)
    (setq lst
      (cons
        (list
          (vla-get-name obj)
          (list 'color      256       (vlax-get obj 'color))
          (list 'linetype   "ByLayer" (vlax-get obj 'linetype))
          (list 'lineweight -1        (vlax-get obj 'lineweight))
        )
        lst
      )
    )
  )
  (vlax-for blk (vla-get-blocks doc)
    (if
      (and
        (= :vlax-false (vla-get-islayout blk))
        (= :vlax-false (vla-get-isxref blk))
        (= :vlax-false (vla-get-isdynamicblock blk))
        (/= "*" (substr (vla-get-name blk) 1 1))
      )
      (vlax-for obj blk
        (foreach sub (cdr (assoc (vla-get-layer obj) lst))
          (if (= (vlax-get obj (car sub)) (cadr sub))
            (vlax-put obj (car sub) (caddr sub))
          )
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)

[bart]

Je kan ook met laytrans aan de slag gaan.

[Fly]

@roy_043. De LISP werkt! Waarvoor Dank!! 
@bart: Met laytrans nemen de objecten de eigenschappen over van de nieuwe laag. De bedoeling is eerst dat de oude eigenschappen behouden blijven. Dus al de objecten in de block's moeten eerst op objectniveau worden gezet. Nadien kunnen we inderdaad starten met Laytrans.
Roy_043 heeft dit probleem mooi opgelost. Voorwaarde is wel dat al de layers op moeten staan (on en thaw).