_

[LISP] Łączna suma wymiarow

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

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » sty 31, 2018 19:19

Tak - mam ręcznie zmieniane współczynniki szerokości tekstu. Czasami opisy elem liniowych trzeba "wciskać" pomiędzy inne opisy, elementy, linie itp - żeby były czytelne (nie zlały się ).
Dobrze by było gdyby udało się to wyeliminować.
Pozdrawiam.
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 15, 2018 21:46

Czy jest szansa że te ulepszenia o których pisałem wcześniej zostaną wprowadzone ? Da się to zrobić ?
Poza tym co wymieniłem narzędzie śmiga aż miło.
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez ziele_o2k » lut 16, 2018 00:36

SOYER__1 napisał(a):Czy jest szansa że te ulepszenia o których pisałem wcześniej zostaną wprowadzone ? Da się to zrobić ?
Poza tym co wymieniłem narzędzie śmiga aż miło.

Zapomniałem o temacie :shock:
Łap i testuj. Jak będą uwagi, daj znać

Kod: Zaznacz cały
;; ============================================== ;;
;;                                                ;;
;;   @@@@@ @ @@@@ @    @@@@      @@@   @@  @  @   ;;
;;      @  @ @    @    @        @   @ @  @ @ @    ;;
;;     @   @ @@@@ @    @@@@     @   @   @  @@     ;;
;;    @    @ @    @    @        @   @  @   @ @    ;;
;;   @@@@@ @ @@@@ @@@@ @@@@ @@@  @@@  @@@@ @  @   ;;
;;                                                ;;
;; ============================================== ;;
;; 22:50 2018-02-15 © ziele_o2k                   ;;
;; ============================================== ;;
(defun c:detsum ( /  pz:sub _pt _ss _enx _k _v _res _tab _row _hgt _wth _tg1 _tg2 _tg3)
  (defun pz:sub ( @key @val @lst / _itm )
    (if (setq _itm (assoc @key @lst))
      (subst (cons @key (+ @val (cdr _itm))) _itm @lst)
      (cons  (cons @key @val) @lst)
    )
  )
  (if
    (and
      (setq _ss (ssget '((0 . "DIM*"))))
      (setq _pt (cd:USR_GetPoint "\nWskaz punkt wstawienia tabeli: " 1 nil))
    )
    (progn
      (foreach %1 (cd:SSX_Convert _ss 0)
        (setq
          _enx  (entget %1)
          _k    (vl-string-trim " " (LM:UnFormat (cdr(assoc  1 _enx)) T))
          _v    (cdr(assoc 42 _enx))
          _res  (pz:sub _k _v _res)
        )
      )
      (setq _res
        (vl-sort
          (mapcar
           '(lambda (%)
              (list (car %) (cd:CON_Real2Str (cdr %) 2 1))
            )
            _res
          )
          '(eval (list 'lambda '( a b ) (list '< '(strcase (car a)) '(strcase (car b)))))
        )
      )
      (setq _hgt
        (vla-gettextheight
          (vla-item
            (vla-item (vla-get-dictionaries (cd:ACX_ADoc)) "acad_tablestyle")
            (getvar 'ctablestyle)
          )
          acdatarow
        )
        _tg1 "Zestawienie detali"
        _tg2 "Oznaczenie"
        _tg3 "Suma"
      )
      (setq _tab
        (cd:ACX_AddTable
          (cd:ACX_ASpace) _pt
          (+ (length _res) 2)
          2
          (* 2 _hgt)
          (* _hgt
            (max
              (apply 'max
                (mapcar 'strlen
                  (append
                    (list _tg2)
                    (list _tg3)
                    (apply 'append _res)
                  )
                )
              )
              (/ (strlen _tg1) 2)
            )
          )
        )
      )
      (vla-setText _tab 0 0 _tg1)
      (vla-setText _tab 1 0 _tg2)
      (vla-setText _tab 1 1 _tg3)
      (setq _row 2)
      (foreach %1 _res
        (vla-setText _tab _row 0 (car %1))
        (vla-setText _tab _row 1 (cadr %1))
        (setq _row (1+ _row))
      )
    )
  )
  (princ)
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse)
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 686
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 16, 2018 01:16

Wygląda rewelacyjnie. Wielkie dzięki. Dam cynk jeśli zauważę jakieś " problemy" .
Załączam widok tabeli utworzonej (z tych samych opisów) lispem przed udoskonaleniem (z lewej) i po udoskonaleniu.

Widok mówi sam za siebie.

Pozdr.
zestawienia.png
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 16, 2018 01:30

To co widać w lewej kolumnie (prawej tabeli) to chyba przekroczony limit enterów lub spacji w opisie.
Znalazłem ten opis na rys - skasowałem ze 3 spacje i teraz tabela jest już elegancka .
Bardzo przydatna rzecz. Dzięki.
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez ziele_o2k » lut 16, 2018 10:17

SOYER__1 napisał(a):To co widać w lewej kolumnie (prawej tabeli) to chyba przekroczony limit enterów lub spacji w opisie.
Znalazłem ten opis na rys - skasowałem ze 3 spacje i teraz tabela jest już elegancka .
Bardzo przydatna rzecz. Dzięki.

Wrzuć przykładowy plik, może uda mi się ogarnąć to programowo :)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 686
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 16, 2018 10:30

W zał. plik z opisami.
Załączniki
zestawienie.dwg
(114.19 KiB) Pobrane 10 razy
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez ziele_o2k » lut 16, 2018 11:24

Teraz testuj:
Kod: Zaznacz cały
;; ============================================== ;;
;;                                                ;;
;;   @@@@@ @ @@@@ @    @@@@      @@@   @@  @  @   ;;
;;      @  @ @    @    @        @   @ @  @ @ @    ;;
;;     @   @ @@@@ @    @@@@     @   @   @  @@     ;;
;;    @    @ @    @    @        @   @  @   @ @    ;;
;;   @@@@@ @ @@@@ @@@@ @@@@ @@@  @@@  @@@@ @  @   ;;
;;                                                ;;
;; ============================================== ;;
;; 22:50 2018-02-15 © ziele_o2k                   ;;
;; ============================================== ;;
(defun c:detsum ( /  pz:sub _pt _ss _enx _k _v _res _tab _row _hgt _wth _tg1 _tg2 _tg3)
  (defun pz:sub ( @key @val @lst / _itm )
    (if (setq _itm (assoc @key @lst))
      (subst (cons @key (+ @val (cdr _itm))) _itm @lst)
      (cons  (cons @key @val) @lst)
    )
  )
  (if
    (and
      (setq _ss (ssget '((0 . "DIM*"))))
      (setq _pt (cd:USR_GetPoint "\nWskaz punkt wstawienia tabeli: " 1 nil))
    )
    (progn
      (foreach %1 (cd:SSX_Convert _ss 0)
        (setq
          _enx  (entget %1)
          _k    (if
                  (or
                    (not (setq _tmp (LM:UnFormat (cdr(assoc  1 _enx)) T)))
                    (= _tmp "")
                    (and
                      (not (cd:STR_Parse _tmp " " T))
                      (setq _tmp "")
                    )
                  )
                  _tmp
                  (cd:STR_ReParse
                    (cd:STR_Parse
                      (vl-string-trim " " _tmp)
                      " " T
                    )
                    " "
                  )
                )
          _v    (cdr(assoc 42 _enx))
          _res  (pz:sub _k _v _res)
        )
      )
      (setq _res
        (vl-sort
          (mapcar
           '(lambda (%)
              (list (car %) (cd:CON_Real2Str (cdr %) 2 1))
            )
            _res
          )
          '(eval (list 'lambda '( a b ) (list '< '(strcase (car a)) '(strcase (car b)))))
        )
      )
      (setq _hgt
        (vla-gettextheight
          (vla-item
            (vla-item (vla-get-dictionaries (cd:ACX_ADoc)) "acad_tablestyle")
            (getvar 'ctablestyle)
          )
          acdatarow
        )
        _tg1 "Zestawienie detali"
        _tg2 "Oznaczenie"
        _tg3 "Suma"
      )
      (setq _tab
        (cd:ACX_AddTable
          (cd:ACX_ASpace) _pt
          (+ (length _res) 2)
          2
          (* 2 _hgt)
          (* _hgt
            (max
              (apply 'max
                (mapcar 'strlen
                  (append
                    (list _tg2)
                    (list _tg3)
                    (apply 'append _res)
                  )
                )
              )
              (/ (strlen _tg1) 2)
            )
          )
        )
      )
      (vla-setText _tab 0 0 _tg1)
      (vla-setText _tab 1 0 _tg2)
      (vla-setText _tab 1 1 _tg3)
      (setq _row 2)
      (foreach %1 _res
        (vla-setText _tab _row 0 (car %1))
        (vla-setText _tab _row 1 (cadr %1))
        (setq _row (1+ _row))
      )
    )
  )
  (princ)
)

;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse)
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)
Ziele
Avatar użytkownika
ziele_o2k
 
Posty: 686
Dołączył(a): mar 18, 2014 11:33
Lokalizacja: Poznań

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 16, 2018 11:34

Idealnie.

zestawienia_1.png


Dzięki.
Pozdrawiam
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Re: [LISP] Łączna suma wymiarow

Postprzez SOYER__1 » lut 28, 2018 23:00

Czy da się tu jeszcze upchnąć automatyczny wybór warstwy na której powstanie zestawienie/tabela ?
SOYER__1
 
Posty: 98
Dołączył(a): wrz 29, 2015 10:07

Poprzednia stronaNastępna strona

Powrót do AutoCAD

Kto przegląda forum

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