Lista kolorow wybranych obiektow

[niuniuni]

Witam,

Na wstepie powiem, ze mam znikome pojecie o programowaniu w lispie. Mam pewne podstawy VBA, ale widze, ze lisp to zupelnie inna para kaloszy. Chcialbym zmodyfikowac lekko kod, ktory znalazlem na tej stronie. Ten skrypt generuje tabelke z wartwa i dlugoscia wczesniej wybranych elementow. Dziala bardzo dobrze, jednak ja potrzebuje zamiast dlugosci, kolor objektu. Nie chodzi mi tu o kolor warstwy, a obiektu. 

Zupelnie nie widze w kodzie, ktora czesc odpowiada za zwrocenie dlugosci linii. Czy ktos z szanownych forumowiczow orientuje sie w jaki sposob moglbym dokonac powyzszej zmiany w kodzie? 

(defun C:LAYLENGTH ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons (mapcar '(lambda (a) (strcat "Col" (itoa (1+ (vl-position a (car lst)))))) (car lst)) lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("TITLE") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
    )
  )

 

[kruszynski]

tak na pierwszy rzut oka to jest długość elementu:

29 minut temu, niuniuni napisał:

d (vlax-curve-getdistatparam e (vlax-curve-getendparam e))

  kolor ma kod 62 więc można go odczytać tak:

kolor (cdr (assoc 62 (entget e)))

 

[perlon]

    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))	; odczyt nazwy warstwy obiektu
              d (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) ; odczyt dlugosci obiektu
        )
        (if
          (setq o (assoc a l))	; jezeli warstwa jest juz na liscie
          (setq l (subst (list a (+ (cadr o) d)) o l))	; dodaj dlugosc elementu do lacznej dlugosci obiektow warstwy
          (setq l (cons (list a d) l))	; dodaj pare warstwa dlugosc do listy warstw
        )
      )

problem polega na tym, że długości obiektów na poszczególnych warstwach da się sumować ale nie da się sumować ich kolorów 😉

tak więc prosta przeróbka tego lispa raczej nie wchodzi w grę. Jak miałaby wyglądać ta tabelka?

warstwa1 -> kolor1 -> ilość1
warstwa1 -> kolor3 -> ilość3
warstwa2 -> kolor1 -> ilość1
warstwa2 -> kolor2 -> ilość2
warstwa2 -> kolor5 -> ilość5
etc.

???

[perlon]

No i kruszyński był szybszy

Dodam tylko, że jeżeli obiekt ma kolor bylayer to kodu 62 może w ogóle w encji nie być. 

[niuniuni]

5 godzin temu, perlon napisał:

problem polega na tym, że długości obiektów na poszczególnych warstwach da się sumować ale nie da się sumować ich kolorów 😉

tak więc prosta przeróbka tego lispa raczej nie wchodzi w grę. Jak miałaby wyglądać ta tabelka?

warstwa1 -> kolor1 -> ilość1
warstwa1 -> kolor3 -> ilość3
warstwa2 -> kolor1 -> ilość1
warstwa2 -> kolor2 -> ilość2
warstwa2 -> kolor5 -> ilość5
etc.

???

Wlasciwie dlugosc calkowita elementow warstwy nie jest i potrzebna. Teraz zauwazylem, ze ten skrypt nie zupelnie odzwierciedla to czego poszukuje. 

Zalezy mi na takiej tabelce:

linia1 - > warstwalinii1 - > kolorlinii1 -> dlugosclinii1 (ewentualnie)

linia2 - > warstwalinii2 - > kolorlinii2 -> dlugosclinii2 (ewentualnie)

linia3 - > warstwalinii3 - > kolorlinii3 -> dlugosclinii3 (ewentualnie)

 

Tak wiec sumowanie nie jest konieczne, choc w ostateczniosci moge stworzyc kazda linie na odrebnej warstwie i wtedy zaproponowana przez Perlona tabelka tez by byla ok. 

[perlon]

Jeden wiersz tabeli to jeden obiekt (encja)? Inaczej mówiąc ile kresek w zaznaczonym zbiorze to tyle wierszy w tabelce? A jeżeli na jednej warstwie jest kilka kresek w tym samym kolorze to co ma być w tabelce?

Edytowane 11 Lutego 2019 przez perlon

[niuniuni]

tak, dokladnie. 

[niuniuni]

jesli w jednej warstwie jest kilka kresek to kazda kreska powinna byc w kolejnej linii.