_

[LISP] Klik w komórkę - zmiana koloru wiersz

Forum poświęcone flagowemu produktowi oraz aplikacjom pochodnym Autodesku. To jedyne forum mające w tytule nazwę programu, a to ze względu na jego olbrzymią popularność w Polsce. Można tutaj umieszczać również posty z ogólnie pojętej tematyki "Kreślarskie 2D".

[LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez kruuger » cze 20, 2018 09:58

hej,

czy gdzieś coś było do zmiany koloru całego wiersza w tabeli?
klikam sobie we wskazane komórki, a program koloruje wiersza na zadany kolor.

dz.
kruuger
Załączniki
CELL KOLOR.png
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez ziele_o2k » cze 20, 2018 12:20

Na kolanie napisane:
Kod: Zaznacz cały
(defun c:rowtest ( / tmp idx tmp tab)
  (if
    (setq tmp
      (ssget "_X"
        (list '(0 . "ACAD_TABLE")
          (if (= 1 (getvar 'cvport))
            (cons 410 (getvar 'ctab))
            '(410 . "Model")
          )
        )
      )
    )
    (repeat (setq idx (sslength tmp))
      (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
    )
  )
  (setq sel (getpoint "\nWskaż punkt"))
  (setq tmp (LM:getcell tab (trans sel 1 0)))
  (if (vlax-write-enabled-p (car tmp))
      ;;tutaj zmień co Ci się podoba
      (repeat (setq idx (vla-get-columns (car tmp)))
        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-settext (list (car tmp) (cadr tmp) (setq idx (1- idx)) "TEST"))))
      )
      ;;tutaj zmień co Ci się podoba
      (prompt "\nWskazana tabela znajduje się an zablokowanej warstwie.")
  )
  (princ)
)

;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)


Teraz zamiast tekstu musisz dać SetCellBackgroundColor i bydzie.
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 732
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez ziele_o2k » cze 20, 2018 12:47

Tutaj masz z kolorem:
Kod: Zaznacz cały
(defun c:rowtest ( / tmp idx tmp tab col_obj)
  (if
    (setq tmp
      (ssget "_X"
        (list '(0 . "ACAD_TABLE")
          (if (= 1 (getvar 'cvport))
            (cons 410 (getvar 'ctab))
            '(410 . "Model")
          )
        )
      )
    )
    (repeat (setq idx (sslength tmp))
      (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
    )
  )
  (setq sel (getpoint "\nWskaż punkt"))
  (setq tmp (LM:getcell tab (trans sel 1 0)))
  (if (vlax-write-enabled-p (car tmp))
      (repeat (setq idx (vla-get-columns (car tmp)))
        (setq col_obj (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (vla-put-colorindex col_obj 8)
        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetCellBackgroundColor (list (car tmp) (cadr tmp) (setq idx (1- idx)) col_obj))))
        (vlax-release-object col_obj)
      )
      ;;tutaj zmień co Ci się podoba
      (prompt "\nWskazana tabela znajduje się an zablokowanej warstwie.")
  )
  (princ)
)

;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 732
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez kruuger » cze 20, 2018 13:42

ziele_o2k napisał(a):Tutaj masz z kolorem:
Kod: Zaznacz cały
(defun c:rowtest ( / tmp idx tmp tab col_obj)
  (if
    (setq tmp
      (ssget "_X"
        (list '(0 . "ACAD_TABLE")
          (if (= 1 (getvar 'cvport))
            (cons 410 (getvar 'ctab))
            '(410 . "Model")
          )
        )
      )
    )
    (repeat (setq idx (sslength tmp))
      (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
    )
  )
  (setq sel (getpoint "\nWskaż punkt"))
  (setq tmp (LM:getcell tab (trans sel 1 0)))
  (if (vlax-write-enabled-p (car tmp))
      (repeat (setq idx (vla-get-columns (car tmp)))
        (setq col_obj (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
        (vla-put-colorindex col_obj 8)
        (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-SetCellBackgroundColor (list (car tmp) (cadr tmp) (setq idx (1- idx)) col_obj))))
        (vlax-release-object col_obj)
      )
      ;;tutaj zmień co Ci się podoba
      (prompt "\nWskazana tabela znajduje się an zablokowanej warstwie.")
  )
  (princ)
)

;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

oo, panie, ale piekne. no teraz mozna pracowac.
dzieki
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez kruuger » cze 20, 2018 13:55

jaki jest kolor dla NONE ?
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez ziele_o2k » cze 20, 2018 14:19

kruuger napisał(a):jaki jest kolor dla NONE ?

To inaczej trza:
Kod: Zaznacz cały
(defun c:rowtest ( / tmp idx tmp tab col_obj)
  (if
    (setq tmp
      (ssget "_X"
        (list '(0 . "ACAD_TABLE")
          (if (= 1 (getvar 'cvport))
            (cons 410 (getvar 'ctab))
            '(410 . "Model")
          )
        )
      )
    )
    (repeat (setq idx (sslength tmp))
      (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
    )
  )
  (setq sel (getpoint "\nWskaż punkt"))
  (setq tmp (LM:getcell tab (trans sel 1 0)))
  (if (vlax-write-enabled-p (car tmp))
      (repeat (setq idx (vla-get-columns (car tmp)))
        (not
          (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-setcellbackgroundcolornone
              (list (car tmp) (cadr tmp) (setq idx (1- idx)) :vlax-true)
            )
          )
        )
      ) 
      (prompt "\nWskazana tabela znajduje się an zablokowanej warstwie.")
  )
  (princ)
)

;(vlax-dump-object (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))) t)
;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 732
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez kruuger » cze 20, 2018 16:58

ziele_o2k napisał(a):
kruuger napisał(a):jaki jest kolor dla NONE ?

To inaczej trza:
Kod: Zaznacz cały
(defun c:rowtest ( / tmp idx tmp tab col_obj)
  (if
    (setq tmp
      (ssget "_X"
        (list '(0 . "ACAD_TABLE")
          (if (= 1 (getvar 'cvport))
            (cons 410 (getvar 'ctab))
            '(410 . "Model")
          )
        )
      )
    )
    (repeat (setq idx (sslength tmp))
      (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
    )
  )
  (setq sel (getpoint "\nWskaż punkt"))
  (setq tmp (LM:getcell tab (trans sel 1 0)))
  (if (vlax-write-enabled-p (car tmp))
      (repeat (setq idx (vla-get-columns (car tmp)))
        (not
          (vl-catch-all-error-p
            (vl-catch-all-apply
              'vla-setcellbackgroundcolornone
              (list (car tmp) (cadr tmp) (setq idx (1- idx)) :vlax-true)
            )
          )
        )
      ) 
      (prompt "\nWskazana tabela znajduje się an zablokowanej warstwie.")
  )
  (princ)
)

;(vlax-dump-object (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))) t)
;; Get Cell  -  Lee Mac
;; If the supplied point lies within a cell boundary,
;; returns a list of: (<VLA Table Object> <Row> <Col>)
 
(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)

;; Application Object  -  Lee Mac
;; Returns the VLA Application Object

(defun LM:acapp nil
    (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
    (LM:acapp)
)

o zesz, wielkie dzieki, poprzerabiam troche na moje potrzeby. jak wyjdzie cos sensownego to wrzuce.
k
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków

Re: [LISP] Klik w komórkę - zmiana koloru wiersz

Postprzez kruuger » cze 20, 2018 23:12

cos takiego potrzebowalem, zmieniarka na dwa kolory. moze ktos skorzysta.
k.
EDIT: dodany znacznik konca Undo.
Załączniki
ChangeTableRowColor.lsp
(2.74 KiB) Pobrane 15 razy
Avatar użytkownika
kruuger
 
Posty: 4839
Dołączył(a): paź 27, 2005 20:14
Lokalizacja: Kraków


Powrót do AutoCAD

Kto przegląda forum

Użytkownicy przeglądający ten dział: Brak zidentyfikowanych użytkowników