sumowanie linii cad

Szybkie sumowanie linii/polylinii w Cadzie (wpis #3)

Cześć 🙂

Później opisałem lisp-a do sumowania długość linii w cadzie, pomaga zliczyć wiele linii jednocześnie. Sprawdza się szczególnie dobrze gdy chcemy zliczyć elementy liniowe takie jak:
-wieńce
-długości ścian
-detale

Nakładka uwzględnia krzywe typu: LINE, POLYLINE, LWPOLYLIE, CIRCLE, ARC, SPLINE, ELLIPSE
Dokładność wyświetlenia wyników wybierana jest przez program.
Program zawiera trzy polecenia:
LNGS – obliczenie sumy długości krzywych wszystkich klas na aktywnej warstwie (zaznaczone obiekty)
LAYLEN – obliczenia sum długości krzywych poszczególnych klas na wybranej warstwie
LNG – obliczenie długości wskazanej krzywej, oczywiście można to sprawdzić w właściwościach obiektu

Instrukcja stosowania

1. Ściągamy pliki z nakładką i zapisujemy na dysku lokalnym.

Na końcu artykułu zamieściłem kod źródłowy funkcji gdyby pojawiły się problemy z poraniem plików.

2. Otwieramy CAD-a i uruchamiamy nakładkę poprzez komendę _appload.

Screen nr 2.1

Screen nr 2.1

Screen nr 2.2

Screen nr 2.2

3. Podgrywamy folder wspomagający z plikiem LAYLEN.DCL

Screen nr 3.1

Screen nr 3.1

4.Opis poszczególnych poleceń.

4.1 Polecenie LNGS

Obliczenie sumy długości krzywych wszystkich klas na aktywnej warstwie (zaznaczone obiekty)

Screen nr 4.1.1

Screen nr 4.1.1

Screen nr 4.1.2

Screen nr 4.1.2

Screen nr 4.1.3

Screen nr 4.1.3

4.2 Polecenie LAYLEN

Wyświetla okno dialogowe z podziałem na warstwy i rodzajami linii. Wartości długości linii dotyczą wszystkich obiektów na danej warstwie znajdujących się aktualnie w pliku.

Screen nr 4.2.1

Screen nr 4.2.1

4.3 Polecenie LNG

Działa podobnie jak funkcja LNGS lecz dotyczy tylko wskazanej linii, przydatna funkcja kiedy chcemy wyświetlić długość wskazanej linii/polilinii bez konieczności wchodzenia w właściwości.

Screen nr 4.3.1

Screen nr 4.3.1

5.Skrypty funkcji.

5.1 LAYLEN.DCL

Kopjujemy tekst do notatnika i zapisujemy z rozszerzeniem .DCL

// Okno dialogowe do programu c:laylen 
// Nalezy zapisac w pliku LAYLEN.DCL 
laylen:dialog{ 
      label="Entities lengh calculation"; 
      :row{ 
       :boxed_column{ 
          label="Layer"; 
         :popup_list{ 
          key="layer"; 
         } 
        } 
        :boxed_column{ 
          label="Precision"; 
         :popup_list{ 
          key="prec"; 
          value="2"; 
         } 
        } 
      } 
      :spacer{} 
      :spacer{} 
      :row{//2 
      :boxed_column{ 
        label="Entities:"; 
        :toggle{ 
          label="&LINE"; 
          key="Tline"; 
          value="0"; 
        } 
         :toggle{ 
          label="&CIRCLE"; 
          key="Tcircle"; 
          value="0"; 
        } 
        :toggle{ 
          label="&ARC"; 
          key="Tarc"; 
          value="0"; 
        } 
        :toggle{ 
          label="&ELLIPSE"; 
          key="Tellipse"; 
          value="0"; 
        } 
        :toggle{ 
          label="&POLYLINE"; 
          key="Tpolyline"; 
          value="0"; 
       } 
        :toggle{ 
          label="&SPLINE"; 
          key="Tspline"; 
          value="0"; 
        } 
     } 
      :boxed_column{ 
        label="Entites lenght"; 
        width=10; 
        children_alignment=right; 
        :text{ 
          key="Lline"; 
          value="0.0"; 
         } 
        :text{ 
          key="Lcircle"; 
          value="0.0"; 
         } 
        :text{ 
          key="Larc"; 
          value="0.0"; 
         } 
        :text{ 
          key="Lellipse"; 
          value="0.0"; 
         } 
        :text{ 
          key="Lpolyline"; 
          value="0.0"; 
         } 
        :text{ 
          key="Lspline"; 
          value="0.0"; 
        } 
      } 
      
      }//2 
      :spacer{} 
      :boxed_row{//3 
         label="Total entities lenght:"; 
         :text_part{ 
             width=30; 
             alignment=centered; 
             key="total"; 
             value="0.0"; 
          } 

      }//3 
      
      ok_only; 
}// koniec definicji okna dialogowego 

5.1 laylen.LSP

Kopiujemy tekst do notatnika i zapisujemy z rozszerzeniem .LSP

;;;Program do obliczania dlugosci krzywych w programie AutoCad 
;;;Uwzglednia krzywe typu: LINE, POLYLINE, LWPOLYLIE, 
;;;CIRCLE, ARC, SPLINE, ELLIPSE 
;;;Dokladnosc wyswietlenia wyników: wybierana programowo 
;;;Program zawiera trzy polecenia: 
;;;LNG - obliczenie dlugosci wskazanej krzywej, 
;;;LNGS - obliczenie sumy dlugosci krzywych wszystkich klas na aktywnej warstwie 
;;;LAYLEN - obliczenia sum dlugosci krzywych poszczególnych klas na wybranej warstwie 
;;; 
;;; 
;;;Zezwala sie na kopiowanie i rozpowszechnianie programu pod warunkiem; 
;;;niepobierania zadnych oplat z tym zwiazanych. 
;;;Wszelkie uwagi i informacje dotyczace poprawy dzialania i inne sugestie 
;;;mozna kierowac na: 
;;;bimowisko@gmail.com

(defun c:lng (/ id res) 
  (if (setq id (car (entsel))) 
    (progn 
      (setq res (#LNGTH id)) 
      (princ "\nDlugosc krzywej: ") 
      (princ (if (/= 0.0 res) 
          (rtos res 2 #prec) 
          " nieokreslona" 
        ) 
      ) 
    ) 
  ) 
  (princ) 
);; 

(defun dxf (kod ent) 
  (cdr (assoc kod ent)) 
);; 

(defun #LNGTH (id / cmd vol ent res) 
  (defun Dlug (ent / v) 
    (setq v (dxf 0 ent)) 
    (cond ((= "LINE" v) 
      (distance (dxf 10 ent) (dxf 11 ent)) 
     ) 
     ((= "ARC" v) 
      (* (abs (- (dxf 50 ent) (dxf 51 ent))) 
         (dxf 40 ent) 
      ) 
     ) 
     ((= "CIRCLE" v) 
      (* 2.0 pi (dxf 40 ent)) 
     ) 
     (T 0.0) 
    ) 
  )               ; 
  ;; ======== ;; 
  (if id 
    (progn 
      (setq cmd (getvar "cmdecho")) 
      (setvar "cmdecho" 0) 
      (setq vol (dxf 0 (setq ent (entget id)))) 
      (setq res 
        (cond 
          ((member   vol 
         '("LWPOLYLINE" "POLYLINE" "SPLINE" "ELLIPSE" "REGION") 
      ) 
                (vlax-curve-getdistatparam id(abs(-(vlax-curve-getendparam id) 
                                                   (vlax-curve-getstartparam id) 
                                             )   ) 
                )  
          ) 
          ((member vol '("LINE" "ARC" "CIRCLE")) 
      (Dlug ent) 
          ) 
          (T 0.0) 
        ) 
      ) 
      (setvar "cmdecho" cmd) 
    ) 
  ) 
  res 
);; 

(defun c:lngS (/ ss n res lay) 
  (setq lay (getvar "clayer")) 
  (prompt (strcat "\nKrzywe na warstwie: <" lay ">")) 
  (if (setq ss (ssget (list (cons 8 lay)))) 
    (progn 
      (setq n   -1 
       res   0.0 
      ) 
      (repeat (sslength ss) 
   (setq 
     res (+ res 
       (atof (rtos (#LNGTH (ssname ss (setq n (1+ n)))) 2 #prec)) 
         ) 
   ) 
      ) 
      (princ 
   (strcat   "\nSuma dlugosci wskazanych krzywych na warstwie <" 
      lay 
      ">: " 
   ) 
      ) 
      (princ (rtos res 2 #prec)) 
    ) 
  ) 
  (princ) 
) 
;;c:lngs 

(defun tnlist (tbname / tdata tblist) 
  (while (setq tdata (tblnext tbname (not tdata))) 
    (setq tblist (append tblist (list (dxf 2 tdata)))) 
  ) 
)               ;: 

(defun NrWar (w lst / li) 
  (cond   ((setq li (member (strcase w) lst)) 
    (- (length lst) (length li)) 
   ) 
   (T 0) 
  ) 
) 
;; 


(defun sumaObj (obj lay   flag / fil ss res n tile Sres) 
  (setq tile (strcat "L" (strcase obj T))) 
  (if (= 1 flag) 
    (progn 
      (setq fil   (cond ((= obj "POLYLINE") 
             (list '(-4 . "<AND") 
                             (cons 67 0) 
              '(-4 . "<OR") 
              '(0 . "LWPOLYLINE") 
              '(0 . "POLYLINE") 
              '(-4 . "OR>") 
              (cons 8 lay) 
              '(-4 . "AND>") 
             ) 
            ) 
            (T (list (cons 67 0)(cons 0 obj) (cons 8 lay))) 
      ) 
      ) 
      (if (setq ss (ssget "X" fil)) 
   (progn 
     (setq   n   -1 
      res 0.0 
     ) 
     (repeat (sslength ss) 
       (setq res 
         (+ res (#LNGTH(ssname  ss (setq n (1+ n)))) 
;;;            (atof (rtos (#LNGTH (ssname ss (setq n (1+ n)))) 2 #prec) 
;;;            ) 
         ) 
       ) 
     ) 
     (setq Sres (rtos res 2 #prec)) 
   ) 
   (setq res  0.0 
;;;     Sres "0.00" 
        ) 
      ) 
    ) 
    (setq res  0.0 
;;;     Sres "0.00" 
    ) 
  ) 
  (set_tile tile (rtos res 2 #prec)) 
  res 
) 
;; sumaObj 

(defun c:laylen   (/   #dcl   #dial  #key   #val   #lay   #obj 
       #lstW   #flL   #flA   #flC   #flP   #flE   #flS 
       #totL   #totA  #totC  #totP  #totE  #totS 
                 #dm #lstP 
      ) 

  (defun ZmFL (obj / ob) 
    (setq obj (strcase (substr obj 2))) 
    (cond ((= obj "LINE") 
      (setq #totL (sumaObj obj #lay #flL)) 
     ) 
     ((= obj "ARC") 
      (setq #totA (sumaObj obj #lay #flA)) 
     ) 
     ((= obj "CIRCLE") 
      (setq #totC (sumaObj obj #lay #flC)) 
     ) 
     ((= obj "POLYLINE") 
      (setq #totP (sumaObj obj #lay #flP)) 
     ) 
     ((= obj "ELLIPSE") 
      (setq #totE (sumaObj obj #lay #flE)) 
     ) 
     ((= obj "SPLINE") 
      (setq #totS (sumaObj obj #lay #flS)) 
     ) 
    ) 
    (#tot) 
  ) 
  ;; 

  (defun SumaAll (lay 
        / 
        sum nwz 
       ) 
    (setq sum 
      (+ (setq #totL (sumaObj "LINE" lay #flL)) 
         (setq #totC (sumaObj "CIRCLE" lay #flC)) 
         (setq #totA (sumaObj "ARC" lay #flA)) 
         (setq #totP (sumaObj "POLYLINE" lay #flP)) 
         (setq #totS (sumaObj "SPLINE" lay #flS)) 
         (setq #totE (sumaObj "ELLIPSE" lay #flE)) 
      ) 
    ) 
    (set_tile "total" (rtos sum 2 #prec)) 
  ) 
  ;; SumaAll 

  (defun #tot () 
    (set_tile "total" 
         (rtos (+ #totL #totA #totC #totP #totE #totS) 2 #prec) 
    ) 
  ) 
  ;; 

  ;;; ====== 
  (setq #dm(getvar "dimzin") 
   nwz(logand #dm(~ 8)) 
   nwz(logand nwz(~ 4)) 
  ) 
  (setq #lstP'("0" "0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000" "0.00000000")) 
  (setvar"dimzin"nwz) 
  (setq #dial "laylen") 
  (if (< (setq #dcl (load_dialog #dial)) 
    0 
      ) 
    (progn (alert (strcat "  Brak pliku okna dialogowego " 
           (strcase #dial) 
           ".DCL\n" 
           "Sprawdz katalog pomocniczy.  \n" 
           "oraz ustawienie ACADa" 
        ) 
      ) 
      (exit) 
    ) 
  ) 
  (if (null (new_dialog #dial #dcl)) 
    (progn (alert (strcat "Blad otwarcia okna dialogowego" #dial)) 
      (exit) 
    ) 
  ) 
  (start_list "layer" 3) 
  (mapcar 'add_list 
     (setq #lstW (acad_strlsort (tnlist "layer"))) 
  ) 
  (end_list) 
  (set_tile "layer" 
       (itoa (NrWar (setq #lay (getvar "clayer")) #lstW)) 
  ) 
  (start_list "prec" 3) 
  (mapcar 'add_list #lstP) 
  (end_list) 

  (setq   #flL (atoi (get_tile "Tline")) 
   #flA (atoi (get_tile "Tarc")) 
   #flC (atoi (get_tile "Tcircle")) 
   #flP (atoi (get_tile "Tpolyline")) 
   #flS (atoi (get_tile "Tspline")) 
   #flE (atoi (get_tile "Tellipse")) 
  ) 
  (sumaAll #lay) 
  (action_tile"prec" "(setq #prec(atoi $value))(sumaAll #lay) ") 
  (action_tile 
    "layer" 
    "(setq #lay (nth (atoi $value) #lstW)) 
                        (SumaAll #lay) 
                       " 
  ) 
  (action_tile 
    "Tline" 
    "(setq #flL(atoi $value))(ZmFL $key)" 
  ) 
  (action_tile "Tarc" "(setq #flA(atoi $value))(ZmFL $key)") 
  (action_tile 
    "Tcircle" 
    "(setq #flC(atoi $value))(ZmFL $key)" 
  ) 
  (action_tile 
    "Tpolyline" 
    "(setq #flP(atoi $value))(ZmFL $key)" 
  ) 
  (action_tile 
    "Tspline" 
    "(setq #flS(atoi $value))(ZmFL $key)" 
  ) 
  (action_tile 
    "Tellipse" 
    "(setq #flE(atoi $value))(ZmFL $key)" 
  ) 
  (action_tile "accept" "(done_dialog 0)") 
  (start_dialog) 
  (unload_dialog #dcl) 
  (setvar"dimzin" #dm) 
  (princ) 
) 
;;c:laylen 

(vl-load-com) 
(setq #prec 2) 
(princ"\n Wczytano polecenia: LAYLEN, LNG, LNGS.\n") 
(princ) 
;;EOF 

Dzięki i do zobaczenia w kolejnych artykułach 🙂

Jeśli artykuł okazał się dla Ciebie przydatny to zostaw proszę komentarz, łapkę w górę oraz polub stronę na fb 🙂 każda reakcja zwiększa zasięgi strony, dzięki czemu więcej osób będzie mogło skorzystać z informacji zawartych w artykule.