brak funkcji SETBYLAYER


zwonko

Rekomendowane odpowiedzi

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ę?

Odnośnik do komentarza
Udostępnij na innych stronach

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....

Odnośnik do komentarza
Udostępnij na innych stronach

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

Odnośnik do komentarza
Udostępnij na innych stronach

Mam dwie uwagi.

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

setbylayer_setup_dialog.png.856ba869476fe8da81bc2b851bf172a3.png

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 przez kojacek
Odnośnik do komentarza
Udostępnij na innych stronach

@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?

Odnośnik do komentarza
Udostępnij na innych stronach

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 przez kojacek
Odnośnik do komentarza
Udostępnij na innych stronach

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

 

Odnośnik do komentarza
Udostępnij na innych stronach

Dołącz do dyskusji

Możesz dodać zawartość już teraz a zarejestrować się później. Jeśli posiadasz już konto, zaloguj się aby dodać zawartość za jego pomocą.

Gość
Dodaj odpowiedź do tematu...

×   Wklejono zawartość z formatowaniem.   Usuń formatowanie

  Dozwolonych jest tylko 75 emoji.

×   Odnośnik został automatycznie osadzony.   Przywróć wyświetlanie jako odnośnik

×   Przywrócono poprzednią zawartość.   Wyczyść edytor

×   Nie możesz bezpośrednio wkleić grafiki. Dodaj lub załącz grafiki z adresu URL.

Ładowanie