Rekomendowane odpowiedzi

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

 

Udostępnij tego posta


Odnośnik do posta
Udostępnij na innych stronach

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

 

Udostępnij tego posta


Odnośnik do posta
Udostępnij na innych stronach
    (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.

???

Udostępnij tego posta


Odnośnik do posta
Udostępnij na innych stronach
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. 

Udostępnij tego posta


Odnośnik do posta
Udostępnij na innych stronach

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 przez perlon

Udostępnij tego posta


Odnośnik do posta
Udostępnij na innych stronach

Jeśli chcesz dodać odpowiedź, zaloguj się lub zarejestruj nowe konto

Jedynie zarejestrowani użytkownicy mogą komentować zawartość tej strony.

Zarejestruj nowe konto

Załóż nowe konto. To bardzo proste!

Zarejestruj się

Zaloguj się

Posiadasz już konto? Zaloguj się poniżej.

Zaloguj się