brak funkcji SETBYLAYER

[zwonko]

W autocadzie istnieję bardzo przydatna funkcja setbylayer, która ustawia właściwości zaznaczonych elementów na "ByLayer". Co ważne działa również wewnątrz bloków. Niesety brakuje jej w ZWCAD. Szukałem jakiś lispów zastępczych nawet na tym forum, ale albo nie działają wcale, albo nie działają na bloki. Ktoś ma może lispa co może zastąpić tą funkcję?

[zwonko]

Znalazłem coś co prawie robi to co chciałem:

(defun c:c252 ( / doc )
   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   (vlax-for blk (vla-get-blocks doc)
       (if (= :vlax-false (vla-get-isxref blk))
           (vlax-for obj blk (vl-catch-all-apply 'vla-put-color (list obj acbylayer)))
       )
   )
   (vla-regen doc acallviewports)
   (princ)
)
(vl-load-com) (princ)

Z tym, że działa to na cały rysunek a chciałbym żeby działał tylko na zaznaczone bloki....

[dmatusz3]

Dobrze, postaramy się zmienić skrypt tak, aby działał tylko na wybrane obiekty.

[kruszynski]

Taki skrypt mógłby wyglądać tak:

(vl-load-com)

(defun c:setByLayer ( / wybrane doc )
	(setq wybrane (SelSet:Get "Wybierz elementy do zmiany" nil) )
	(SetByLayer wybrane)
	(vla-regen ( GetThisDrawing ) acallviewports)
   (princ)
)

(defun SetByLayer ( dozmiany / format )
	(defun format ( element /  ) 
		(setq ans (vl-catch-all-apply 'vlax-put-property (list element 'Color acbylayer ) ))
		(if (vl-catch-all-error-p ans)
			(princ (vl-catch-all-error-message ans ))
		)
	)
	
	(cond
		((listp dozmiany) (progn
			(foreach % dozmiany
				(SetByLayer %)
			)	
		))
		((= (vlax-get-property dozmiany 'EntityName ) "AcDbBlockReference") (progn
			(format dozmiany)
			(setq elementy (Block:GetItems (vlax-get-property dozmiany 'Name )))
			(SetByLayer elementy)
		))
		(t (progn
			(format dozmiany)
		))
	)	
	nil
)

(defun GetThisDrawing ( / ) 
	(vla-get-activedocument (vlax-get-acad-object) )
)

(defun SelSet:ToList (selset / Wynik ileelementow i 
 *error* ) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nSelSet:ToList:*error*: " ) (princ msg ) (princ "\n")	) )
	)      
 (if selset (progn
 (setq ileelementow(sslength selset) )
 (setq i 0 )
 (repeat ileelementow
	(setq Wynik (append Wynik (list (vlax-ename->vla-object(ssname selset i) ) )))
	(setq i (1+ i ))
 )
 ))
 Wynik
)

(defun SelSet:FilterByType ( elementy typy / sl i % 
 *error* ) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nSelSet:FilterByType:*error*: " ) (princ msg ) (princ "\n")	) )
	)      
; (setq elementy (ssget ) )
  (setq sl (sslength elementy))
  (setq i (1- sl ))
    (repeat sl
	  (setq % (ssname elementy i))
	  
	  (if (not (member (cdr(assoc 0 (entget %) )) typy))
		(setq elementy(ssdel % elementy))
	  )
      (setq i (1- i) )
    )
)


(defun SelSet:Get (tresc typy / selElems elementy Filter % OldNoMutt  
 *error* ) 	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\n SelSet:Get:*error*: " ) (princ msg ) (princ "\n")	) )
	)      		
;----------------------------------------------------------
; funkcja sprawdza, czy jakieś elementy zostały zaznaczone, jeśli nie, prosi użytkownika o wskazanie obiektów
; Argumenty: tresc - komunikat wyświetlany w pasku poleceń zachęta do wskazanie obiektów
; Wynik: lista wybranych obiektów jeśli coś zostało wybranie
;		 nil jeśli nic nie zostało wybrane.
; ----------------------------------------------------------
; versja 2.0
; dodane filtrowanie typów
; ----------------------------------------------------------
; test:
;(sslength (ssget (list (cons 0  "3DSOLID") )))
; ----------------------------------------------------------


(if typy (progn
	(if (listp (car typy) ) 
		(setq Filter typy )
	(progn
		(setq Filter (list (cons -4 "<or" )))
		(foreach % typy
			(setq Filter (append Filter  (list (cons 0 % ) )))
		)
		(setq Filter (append Filter  (list (cons -4 "or>" ) )))	
	)
	)
))
 

  (setq selElems(ssgetfirst ))
  (if (car selElems)
	(progn
		(setq elementy (SelSet:ToList(SelSet:FilterByType selElems typy)))
	)
	(progn
	   (setq tresc (strcat "\n" tresc ": ") )
	   (princ tresc )
	   (setq OldNoMutt (getvar 'NOMUTT))	
	   (setvar 'NOMUTT 1)
	   (setq elementy
				(if (null Filter)
					(vl-catch-all-apply 'ssget )
					(vl-catch-all-apply 'ssget (list Filter ))
				)
		)
		(setvar 'NOMUTT OldNoMutt )
	   
	   (if (not(vl-catch-all-error-p elementy))
		  (progn
		    (setq elementy (SelSet:ToList elementy ))
		  )
		  (progn 
			(setq elementy nil)
		  )
		)
	)  
  )
  elementy
)

(defun Blocks:Get ( BlockName / blocks Def
	*error* )	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nBlocks:Get:*error*: " ) (princ msg ) (princ "\n")	) )
	)	
	(setq blocks ( vlax-get-property ( GetThisDrawing ) 'Blocks ) )
	(setq Def(vl-catch-all-apply 'vlax-invoke-method ( list blocks 'Item BlockName ) ) )
	(if (vl-catch-all-error-p Def)
		(setq Def nil )
	)
	Def
)

(defun Block:GetItems ( nazwa / definicja ileElementow i element elementy
	*error* )	(defun *error* ( msg / ) 
		(if (not (null msg ) )	(progn (princ "\nBlock:GetItems:*error*: " ) (princ msg ) (princ "\n")	) )
	)
	(setq definicja (Blocks:Get nazwa ) )
	(setq ileElementow ( vlax-get-property definicja 'Count ))
	(setq i 0)
	(repeat ileElementow 
		(setq element (vla-item definicja i))
		(setq elementy (append elementy (list element )))
		(setq i (1+ i))
	)
	elementy			
)

(princ)

 

SetByLayer.lsp

[kojacek]

Mam dwie uwagi.

1) AutoCAD-we SETBYLAYER zmienia więcej właściwości niźli tylko kolor:

2) Jeżeli zaś chodzi o kolor tylko, mam wrażenie że to można załatwić używając amunicji mniejszego kalibru, Wystarczy wiedzieć że w danych DXF obiektu kod 62 odpowiada za jego kolor. I tak jeśli kod 62 ma wartość 256 (lub w danych nie ma tego kodu) to obiekt ma kolor logiczny jakwarstwa. Wynika z tego że wystarczy manipulować wartością kodu 62 danych DXF obiektu. Klasycznie entmodem, bez żdnych com... vla-... etc. Tak samo można w inteligentny sposób wybierać obiekty do zmiany (po co wybierać te które już są JakWarstwa?). Poniższy kod wystarczy aby wybrać obiekty z niezamknietych warstw i które nie mają koloru JakWarstwa i takimi je uczynić:

(if
  (setq ss
    (ssget "_:L" '((-4 . "/=")(62 . 256)))
  )
  (foreach % (cd:SSX_Convert ss 0)
    (cd:ENT_SetDXF % 62 256)
  )
)

Wykorzystuję tu dwie funcje biblioteczne CADPL-Pack-a, który krótko przedstawiam tutaj.

Edytowane 8 Czerwca 2021 przez kojacek

[Marek-M]

@kojacek!! Zarąbiście prosty kod i faktycznie skuteczny. Przydałoby się jednak, żeby taki setbylayer ustawiał parametry również dla obiektów w blokach a nawet w blokach wielokrotnie zagnieżdżonych. Ten bardziej skomplikowany skrypt daje radę również z takimi blokami. Może jakaś jedna magiczna linijka kodu pozwoli Twojemu rozwiązaniu modyfikować również obiekty wewnątrz bloków?

[kojacek]

7 godzin temu, Marek-M napisał:

@kojacek!! Zarąbiście prosty kod i faktycznie skuteczny. Przydałoby się jednak, żeby taki setbylayer ustawiał parametry również dla obiektów w blokach a nawet w blokach wielokrotnie zagnieżdżonych. Ten bardziej skomplikowany skrypt daje radę również z takimi blokami. Może jakaś jedna magiczna linijka kodu pozwoli Twojemu rozwiązaniu modyfikować również obiekty wewnątrz bloków?

Ustalenie koloru (choć nie tylko) na JakWarstwa dla elementów bloków uważam (nie tylko ja zresztą) raczej za wadę a nie zaletę. Sposób tworzenia bloków (warstwa "0" / kolor / rodzaj linii / szerokość linii ByBlock itd.) to osobny duży temat. O kolorach (i nie tylko) ByLayer i ByBlock pisałem TUTAJ. Zaś z przemianami cech wszelkich elementów bloków, w sposób masowy (czy też jednostkowy) można zapoznać się TU. 

Edytowane 9 Czerwca 2021 przez kojacek

[zwonko]

Ja, praktycznie zawsze potrzebuje żeby wewnątrz bloku były elementy na 0 i Bylayer. Dany blok na jednym rysunku jest widoczny, na innej jest niewidoczny, a na innej jest w ogóle przekrojem. Mamy zatem 3 warstwy, których używamy w róznych miejscach na tym samym bloku.

[zwonko]

Aktualnie znalazłem jeszcze taki, zanim @kruszynski podesłal swój kod (którego nie testowałem).

Ten poniżej, działa na wybrane bloki, niestety nie działa na zagnieżdzone. 

;ColourByLayer.lsp
(vl-load-com)

(defun C:CBL ( / *error* c_doc cme c_blks ss b_name b_lst)

  (defun *error* ( msg )
		(if cme (setvar 'CMDECHO cme))
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
		(princ)
	);_end_*error*_defun
	
	(setq c_doc (vla-get-activedocument (vlax-get-acad-object))
				c_blks (vla-get-blocks c_doc)
	);_end_setq
  
  (cond ( (/= (getvar 'cmdecho) 0) (setq cme (getvar 'cmdecho)) (setvar 'cmdecho 0)))
  
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(vla-startundomark c_doc)

  (setq ss (ssget ":L" '((0 . "INSERT"))))
  
	(vlax-for blk (vla-get-activeselectionset c_doc)
		(setq b_name (vlax-get-property blk (if (vlax-property-available-p blk 'effectivename) 'effectivename 'name)))
    (cond ( (not (vl-position b_name b_lst))
            (vlax-for obj (vla-item c_blks b_name)
              (cond ( (= (vlax-get-property obj 'objectname) "AcDbHatch") (vlax-put-property obj 'color acbylayer))
                    (t (vlax-put-property obj 'color acbylayer))
              );end_cond
            );end_for
            (setq b_lst (cons b_name b_lst))
          )
    );end_cond
    (vla-update blk)        
  );end_for
  
	(vla-regen c_doc acAllViewports)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(if cme (setvar 'cmdecho cme))
  (princ)
);_end_defun