CADsite

  • za 21 09 2019, 11:46:35
  • Welkom, gast
Log in of registreer jezelf.

Login met gebruikersnaam, wachtwoord en sessielengte
Geavanceerd zoeken  

Nieuws:

Pagina's: [1]   Omlaag

Auteur Topic: setbylayerreverse en ApplytoBlockObjects OPGELOST  (gelezen 388 keer)

Fly

  • regelmatige poster
  • ***
  • Offline Offline
  • Berichten: 15
    • Bekijk profiel
setbylayerreverse en ApplytoBlockObjects OPGELOST
« Gepost op: do 18 07 2019, 14:07:49 »

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
« Laatst bewerkt op: vr 19 07 2019, 12:41:47 door Fly »
Gelogd

EddyBeerke

  • forumverslaafde
  • ******
  • Offline Offline
  • Berichten: 2358
  • 1d CADSITE.be niet bezoeken = 1 dag niet geleefd!
    • Bekijk profiel
    • Mijn site
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #1 Gepost op: vr 19 07 2019, 08:20:05 »

Wat is je doel hiermee?
Gelogd

Fly

  • regelmatige poster
  • ***
  • Offline Offline
  • Berichten: 15
    • Bekijk profiel
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #2 Gepost op: vr 19 07 2019, 09:19:23 »

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
Gelogd

roy_043

  • forumverslaafde
  • ******
  • Offline Offline
  • Berichten: 1435
  • BricsCAD 18
    • Bekijk profiel
    • www.b-k-g.nl
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #3 Gepost op: vr 19 07 2019, 09:23:45 »

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

Maar probeer dit eens:
(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)
)
Gelogd

Fly

  • regelmatige poster
  • ***
  • Offline Offline
  • Berichten: 15
    • Bekijk profiel
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #4 Gepost op: vr 19 07 2019, 09:29:59 »

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

grts
Gelogd

roy_043

  • forumverslaafde
  • ******
  • Offline Offline
  • Berichten: 1435
  • BricsCAD 18
    • Bekijk profiel
    • www.b-k-g.nl
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #5 Gepost op: vr 19 07 2019, 10:04:12 »

(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)
)
Gelogd

bart

  • Forum medewerker
  • forumverslaafde
  • *****
  • Offline Offline
  • Berichten: 1995
    • Bekijk profiel
Re: setbylayerreverse en ApplytoBlockObjects
« Reactie #6 Gepost op: vr 19 07 2019, 10:58:17 »

Je kan ook met laytrans aan de slag gaan.



Gelogd
Domme vragen bestaan niet.
Domme antwoorden wel.

m.vr. groet Bart

Fly

  • regelmatige poster
  • ***
  • Offline Offline
  • Berichten: 15
    • Bekijk profiel
Re: setbylayerreverse en ApplytoBlockObjects OPGELOST
« Reactie #7 Gepost op: vr 19 07 2019, 12:41:30 »

@roy_043. De LISP werkt! Waarvoor Dank!!  :D
@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).
Gelogd
Pagina's: [1]   Omhoog