Przykład zmiany koloru wybranego elementu przez nadanie składowych RGB wpisanych przez użytkownika lub nadanie koloru o okreśonym indeksie.

 

Zmiana koloru obiektu

 

Polecenie do uruchomienia skryptu LISP: KolorOb

 

Kod źródłowy z opisem

 

;;; Zmiana koloru obiektu
;;; zwcad.pl
;;; Polecenie do uruchomienia skryptu LISP: KolorOb
;;; Opis: https://www.zwcad.pl/materialy-edukacyjne/kurs-lisp/przyklady-lisp/224-zmiana-koloru-obiektu.html
(vl-load-com)
(setq *ZWCAD* (vlax-get-acad-object))
(setq *Rysunek* (vla-get-activedocument *ZWCAD* ))
(setq *Model* (vla-get-Modelspace *Rysunek* ))
(defun XEntSel (tex / SelObj Sel)
(setq Sel(vl-catch-all-apply 'entsel (list tex))) ; prosi Użytkownika o wybranie jednego obiektu
; jeśli wystąpi błąd w czasie wybierania, np Użytkownik anuluje polecenie, zdażenie
; takie zostanie przechwycone i pozwoli na dalsze działanie programu
(if Sel (progn
(if (vl-catch-all-error-p Sel) ; zwraca t, jeśli wystąpiło przerwanie
(progn
(prompt (vl-catch-all-error-message Sel)) ; wyświetla komunikat błędu
(setq SelObj nil )
)
(progn
(setq SelObj (vlax-ename->vla-object(car Sel))) ; zamienia wybrany obiekt typu entity na obiekt
)
)
))
SelObj
)
(defun XGetInt (tresc domyslny / Wynik liczba)
;----------------------------------------------------------
;funkcja prosi użytkownika o podanie liczby rzeczywistej
;Argumenty: komunikat, zachętę, który sie wyświetli w linii poleceń w chwili uruchomienia funkcji
;Wynik: wartość liczbowa jeśli Użytkownik wpisze wartość z klawiatury
; wartość liczbowa domyślna jeśli Użytkownik na klawiaturze wciśnie [ENTER] [SPACJA]
; nil - jeśli Użytkownik na klawiaturze wciśnie [ESC]
;----------------------------------------------------------
(setq liczba(vl-catch-all-apply 'getint (list tresc )))
(if (vl-catch-all-error-p liczba) ; sprawdzenie czy zwrócony został obiekt błędu
(progn ; wystąpił błąd
(prompt (vl-catch-all-error-message liczba))
(setq Wynik nil )
)
(progn
(if (null liczba)
(setq Wynik domyslny )
(setq Wynik liczba)
)
)
)
Wynik
)
(defun C:KolorOb ( / Wybrany kolor R G B NowyR NowyG NowyB )
;----------------------------------------------------------
; funkcja zmienia kolor wybranego elementu przez nadanie składowych RGB wpisanych przez użytkownika
; Argumenty:
; Wynik:
;----------------------------------------------------------
(setq Wybrany (XEntSel "Wskaż element do zmiany ") )
(if Wybrany (progn
(setq kolor(vlax-get-property Wybrany 'TrueColor ))
(vlax-put-property kolor 'ColorIndex 12 ) ; zmiana koloru na odcień czerwonego
(vlax-put-property Wybrany 'TrueColor kolor ) ; przypisanie zmienionego koloru do obiektu
(setq R (vlax-get-property kolor 'Red )) ; pobranie składowej czerwonej z istniejącego koloru
(setq G (vlax-get-property kolor 'Green )) ; pobranie składowej zielonej z istniejącego koloru
(setq B (vlax-get-property kolor 'Blue )) ; pobranie składowej niebieskiej z istniejącego koloru
(setq NowyR (XGetInt "Podaj składową czerwoną: " R ))
(setq NowyG (XGetInt "Podaj składową zieloną: " G ))
(setq NowyB (XGetInt "Podaj składową niebieską: " B))
(if (and NowyR NowyG NowyB)(progn
(vlax-invoke-method kolor 'SetRGB NowyR NowyG NowyB) ; ustawienie nowego koloru
(vlax-put-property Wybrany 'TrueColor kolor ) ; przypisanie zmienionego koloru do obiektu
))
))
nil
)

 

Wykonanie w ZWCAD 2023

zmiana koloru

 

Wykonanie w ZWCAD 2015

LISP KolorOb 2015

 

Wykonanie w ZWCAD Classic

LISP KolorOb Classic