HOW TO SEPARATE OBJECTS IN LINE TYPE AND ARC TYPE OBJECTS, AND ALL SUM

[rolisonfelipe]

HOW TO SEPARATE OBJECTS IN LINE TYPE AND ARC TYPE OBJECTS ..... AND AT THE END INFORM A HEIGHT TO ADD THE TEXT WITH THE LINEAR DIMENSION ON THE LINES AND ON THE OBJECTS ARCHED WITH THE LENGTH AND THE RAY.
THANK YOU FOR HELP !!!

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************Soma comprimento**********************
;**********************************************************
(defun c:ADD (/ ang1 ang2 comp ctd ent old-error-sl pt1 pt2 rad raio sel sname soma
ss tipo)
(setvar "cmdecho" 0)
(defun @Error_sl (msg)
(command "._regen")
(setq *error* old-error)
(print "*Comando cancelado*")
(setvar "cmdecho" 1)
(princ)
)
(defun @selecao ()
(print "ADD LINHAS")
(setq ss (ssget))
(if ss
(progn
(setq ctd 0)
(repeat (sslength ss)
(setq sname (ssname ss ctd))
(setq ent (entget sname))
(setq tipo (cdr (assoc 0 (entget (ssname ss ctd)))))
(@soma)
(setq ctd (1+ ctd))
)
)
(alert "Nenhuma OBJ selecionada !!!")
)
)
(defun @individual ()
(while
(setq ss (entsel (strcat "\nADD LINHAS :")))
(if ss
(progn
(setq sname (car ss))
(setq ent (entget (car ss)))
(setq tipo (cdr (assoc 0 ent)))
(redraw sname 3)
(@soma)
)
)
)
)
(defun @soma1 ()
(cond
((or
(= tipo "PLINE")
(= tipo "LWPOLYLINE")
)
(progn
(command "area" "o" sname)
(setq soma (+ soma (getvar "perimeter")))
)
)
((= tipo "LINE")
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq soma (+ soma (distance pt1 pt2)))
)
)
)
(defun @soma2 ()
(cond
((or
(= tipo "CIRCLE")
(= tipo "SPLINE")
(= tipo "ELLIPSE")
)
(progn
(command "area" "o" sname)
(setq soma (+ soma (getvar "perimeter")))
)
)
((= tipo "ARC")
(setq raio (cdr (assoc 40 ent)))
(setq ang1 (cdr (assoc 50 ent)))
(setq ang2 (cdr (assoc 51 ent)))
(if (< ang1 ang2)
(setq rad (- ang2 ang1))
(setq rad (+ (* 2 PI) (- ang2 ang1)))
)
(setq comp (* raio rad))
(setq soma (+ soma comp))
)
)
)
(setq old-error-sl *error*)
(setq *error* @Error_sl)
(setq soma 0)
(if (not old-sel)
(progn
(initget "S I")
(setq sel (getkword "\nTipo de seleção (Seleção / Individual) : "))
(if (not sel)
(progn
(setq sel "S")
(setq old-sel "S")
)
(setq old-sel sel)
)
)
(progn
(initget "S I")
(setq sel (getkword (strcat "\nTipo de seleção (Seleção / Individual) <" old-sel
">: ")))
(if (not sel)
(setq sel old-sel)
(setq old-sel sel)
)
)
)
(cond
((= sel "S")(@selecao))
((= sel "I")
(progn
(@individual)
(command "._regen")
)
)
)
(if soma
(progn
(alert (strcat "Distância acumulada: " (rtos soma 2 4)))
(print (strcat "Distância acumulada: " (rtos soma 2 4)))
)
)
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC)

Edited by
Discussion_Admin

[rolisonfelipe]

ADD LISP E MOVE

[Kent1Cooper]

The  @Anonymous function is not defined.

Also, this:

(= tipo "PLINE")

can never happen.  If you want it to process "heavy" Polylines as distinguished from "lightweight" LWPolylines, that should be:

(= tipo "POLYLINE")

[rolisonfelipe]

I WILL TRY TOGETHER THE PARTIES

[rolisonfelipe]

IF I JOIN ALL, ALL SOMA

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************Soma comprimento**********************
;**********************************************************

(defun c:ADD (/ ang1 ang2 comp ctd ent old-error-sl pt1 pt2 rad raio sel sname soma
ss tipo)
(setvar "cmdecho" 0)

(defun @Anonymous_sl (msg)
(command "._regen")
(setq *error* old-error)
(print "*Comando cancelado*")
(setvar "cmdecho" 1)
(princ)
)

(defun @selecao ()
(print "ADD LINHAS")
(setq ss (ssget))
(if ss
(progn
(setq ctd 0)
(repeat (sslength ss)
(setq sname (ssname ss ctd))
(setq ent (entget sname))
(setq tipo (cdr (assoc 0 (entget (ssname ss ctd)))))
(@soma)

(setq ctd (1+ ctd))
)
)
(alert "Nenhuma OBJ selecionada !!!")
)
)

(defun @individual ()
(while
(setq ss (entsel (strcat "\nADD LINHAS :")))
(if ss
(progn
(setq sname (car ss))
(setq ent (entget (car ss)))
(setq tipo (cdr (assoc 0 ent)))
(redraw sname 3)
(@soma)
)
)
)
)

(defun @Anonymous ()
(cond
((or
(= tipo "PLINE")
(= tipo "LWPOLYLINE")
(= tipo "CIRCLE")
(= tipo "SPLINE")
(= tipo "ELLIPSE")
)
(progn
(command "area" "o" sname)
(setq soma (+ soma (getvar "perimeter")))
)
)
((= tipo "LINE")
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq soma (+ soma (distance pt1 pt2)))
)
((= tipo "ARC")
(setq raio (cdr (assoc 40 ent)))
(setq ang1 (cdr (assoc 50 ent)))
(setq ang2 (cdr (assoc 51 ent)))
(if (< ang1 ang2)
(setq rad (- ang2 ang1))
(setq rad (+ (* 2 PI) (- ang2 ang1)))
)
(setq comp (* raio rad))
(setq soma (+ soma comp))
)
)
)

(setq old-error-sl *error*)
(setq *error* @Anonymous_sl)
(setq soma 0)
(if (not old-sel)
(progn
(initget "S I")
(setq sel (getkword "\nTipo de seleção (Seleção / Individual) : "))
(if (not sel)
(progn
(setq sel "S")
(setq old-sel "S")
)
(setq old-sel sel)
)
)
(progn
(initget "S I")
(setq sel (getkword (strcat "\nTipo de seleção (Seleção / Individual) <" old-sel
">: ")))
(if (not sel)
(setq sel old-sel)
(setq old-sel sel)
)
)
)
(cond
((= sel "S")(@selecao))
((= sel "I")
(progn
(@individual)
(command "._regen")
)
)
)
(if soma
(progn
(alert (strcat "Distância acumulada: " (rtos soma 2 4)))
(print (strcat "Distância acumulada: " (rtos soma 2 4)))
)
)
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC)

[rolisonfelipe]

TEST 02 ::::::

Command: (LOAD "C:/Users/rolis/OneDrive/Área de Trabalho/WW.lsp")
Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************SOMA COMPRIMENTOS**********************
;**********************************************************

(defun c:SMC (/ ang1 ang2 comp ctd ent old-error-sl pt1 pt2 rad raio sel sname SOMArco SOMAlinha ss tipo)
(setvar "cmdecho" 0)

(defun @Anonymous_sl (msg)
(command "._regen")
(setq *error* old-error)
(print "*Comando cancelado*")
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @selecao ()
(print "ADD OBJETO")
(setq ss (ssget))
(if ss
(progn
(setq ctd 0)
(repeat (sslength ss)
(setq sname (ssname ss ctd))
(setq ent (entget sname))
(setq tipo (cdr (assoc 0 (entget (ssname ss ctd)))))
(@SOMArco)
(@OMAlinha)

(setq ctd (1+ ctd))
)
)
(alert "Nenhuma OBJ selecionada !!!")
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @individual ()
(while
(setq ss (entsel (strcat "\nADD LINHAS :")))
(if ss
(progn
(setq sname (car ss))
(setq ent (entget (car ss)))
(setq tipo (cdr (assoc 0 ent)))
(redraw sname 3)
(@SOMArco)
(@OMAlinha)
)
)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @SOMAlinha ()
(cond
((or (= tipo "PLINE")(= tipo "LWPOLYLINE"))
(progn
(command "area" "o" sname)
(setq SOMAlinha (+ soma (getvar "perimeter")))
)
)
((= tipo "LINE")
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq SOMAlinha (+ soma (distance pt1 pt2)))
)
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun @SOMArco ()
(cond
((or (= tipo "CIRCLE") (= tipo "SPLINE") (= tipo "ELLIPSE"))
(progn
(command "area" "o" sname)
(setq SOMArco (+ SOMArco (getvar "perimeter")))
)
)
((= tipo "ARC")
(setq raio (cdr (assoc 40 ent)))
(setq ang1 (cdr (assoc 50 ent)))
(setq ang2 (cdr (assoc 51 ent)))
(if (< ang1 ang2)
(setq rad (- ang2 ang1))
(setq rad (+ (* 2 PI) (- ang2 ang1)))
)
(setq comp (* raio rad))
(setq SOMArco (+ SOMArco comp))
)
)
)

(setq old-error-sl *error*)
(setq *error* @Anonymous_sl)
(setq SOMArco 0)
(setq SOMAlinha 0)
(if (not old-sel)
(progn
(initget "S I")
(setq sel (getkword "\nTipo de seleção (Seleção / Individual) : "))
(if (not sel)
(progn
(setq sel "S")
(setq old-sel "S")
)
(setq old-sel sel)
)
)
(progn
(initget "S I")
(setq sel (getkword (strcat "\nTipo de seleção (Seleção / Individual) <" old-sel
">: ")))
(if (not sel)
(setq sel old-sel)
(setq old-sel sel)
)
)
)
(cond
((= sel "S")(@selecao))
((= sel "I")
(progn
(@individual)
(command "._regen")
)
)
)
(if SOMArco
(progn
(alert (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4))
(alert (strcat "COMPRIMENTO NÃO LINEAR: " (rtos SOMArco 2 4))
)
)
(if SOMAlinha
(progn
(alert (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4))
(print (strcat "COMPRIMENTO NÃO LINEAR: " (rtos SOMArco 2 4))
)
)
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC)

[dlanorh]

---

@rolisonfelipe wrote:

TEST 02 ::::::

Command: (LOAD "C:/Users/rolis/OneDrive/Área de Trabalho/WW.lsp")
Cannot invoke (command) from *error* without prior call to (*push-error-using-command*).
Converting (command) calls to (command-s) is recommended.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************SOMA COMPRIMENTOS**********************
;**********************************************************

(defun c:SMC (/ ang1 ang2 comp ctd ent old-error-sl pt1 pt2 rad raio sel sname SOMArco SOMAlinha ss tipo)
(setvar "cmdecho" 0)

(defun @Anonymous_sl (msg)
(command-s  "._regen")
(setq *error* old-error-sl)
(print "*Comando cancelado*")
(setvar "cmdecho" 1)
(princ)
)

---

[dlanorh]

(defun @SOMAlinha ()
(cond
((or (= tipo "POLYLINE")(= tipo "LWPOLYLINE"))
(progn
(command "area" "o" sname)
(setq SOMAlinha (+ soma (getvar "perimeter")))
)
)
((= tipo "LINE")
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq SOMAlinha (+ soma (distance pt1 pt2)))
)
)
)

[rolisonfelipe]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;********************SOMA COMPRIMENTOS**********************
;***********************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:SMC (/        ang1 ang2  comp   ctd    ent
       old-error-sl pt1  pt2   rad    raio
       sel      sname SOMArco  SOMAlinha    ss
       tipo
      )
  (setvar "cmdecho" 0)

  (defun @Anonymous_sl (msg)
    (command-s "._regen")
    (setq *error* old-error-sl)
    (print "*Comando cancelado*")
    (setvar "cmdecho" 1)
    (princ)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @selecao ()
    (print "ADD OBJETO")
    (setq ss (ssget))
    (if ss
      (progn
 (setq ctd 0)
 (repeat (sslength ss)
   (setq sname (ssname ss ctd))
   (setq ent (entget sname))
   (setq tipo (cdr (assoc 0 (entget (ssname ss ctd)))))
   (@SOMArco)
   (@OMAlinha)
   (setq ctd (1+ ctd))
 )
      )
      (alert "Nenhuma OBJ selecionada !!!")
    )
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @individual ()
    (while
      (setq ss (entsel (strcat "\nADD LINHAS :")))
       (if ss
  (progn
    (setq sname (car ss))
    (setq ent (entget (car ss)))
    (setq tipo (cdr (assoc 0 ent)))
    (redraw sname 3)
    (@SOMArco)
    (@OMAlinha)
  )
       )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @SOMAlinha ()
    (cond
      ((or (= tipo "POLYLINE") (= tipo "LWPOLYLINE"))
       (progn
  (command "area" "o" sname)
  (setq SOMAlinha (+ soma (getvar "perimeter")))
       )
      )
      ((= tipo "LINE")
       (setq pt1 (cdr (assoc 10 ent)))
       (setq pt2 (cdr (assoc 11 ent)))
       (setq SOMAlinha (+ soma (distance pt1 pt2)))
      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @SOMArco ()
    (cond
      ((or (= tipo "CIRCLE") (= tipo "SPLINE") (= tipo "ELLIPSE"))
       (progn
  (command "area" "o" sname)
  (setq SOMArco (+ SOMArco (getvar "perimeter")))
       )
      )
      ((= tipo "ARC")
       (setq raio (cdr (assoc 40 ent)))
       (setq ang1 (cdr (assoc 50 ent)))
       (setq ang2 (cdr (assoc 51 ent)))
       (if (< ang1 ang2)
  (setq rad (- ang2 ang1))
  (setq rad (+ (* 2 PI) (- ang2 ang1)))
       )
       (setq comp (* raio rad))
       (setq SOMArco (+ SOMArco comp))
      )
    )
  )

  (setq old-error-sl *error*)
  (setq *error* @Anonymous_sl)
  (setq SOMArco 0)
  (setq SOMAlinha 0)
  (if (not old-sel)
    (progn
      (initget "S I")
      (setq
 sel (getkword "\nTipo de seleção (Seleção / Individual) : ")
      )
      (if (not sel)
 (progn
   (setq sel "S")
   (setq old-sel "S")
 )
 (setq old-sel sel)
      )
    )
    (progn
      (initget "S I")
      (setq sel (getkword
    (strcat "\nTipo de seleção (Seleção / Individual) <"
     old-sel
     ">: "
    )
  )
      )
      (if (not sel)
 (setq sel old-sel)
 (setq old-sel sel)
      )
    )
  )
  (cond
    ((= sel "S") (@selecao))
    ((= sel "I")
     (progn
       (@individual)
       (command "._regen")
     )
    )
  )
  (if SOMArco
    (progn
      (alert (strcat "COMPRIMENTO NÃO LINEAR" (rtos SOMArco 2 4))
      (alert
        (strcat "COMPRIMENTO NÃO LINEAR: " (rtos SOMArco 2 4))
      )
      )
      (if SOMAlinha
 (progn
   (alert (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4))
   (print
     (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4))
   )
   )
   (setvar "cmdecho" 1)
   (princ)
 )
 (PRINC)
      )
    )
  )
)

[dlanorh]

(defun c:SMC ( / ang1 ang2 comp ctd ent old-error-sl pt1 pt2 rad raio sel sname SOMArco SOMAlinha ss tipo)
  (setvar "cmdecho" 0)
  
  (defun @Error_sl (msg)
    (command-s "._regen")
    (setq *error* old-error-sl)
    (print "*Comando cancelado*")
    (setvar "cmdecho" 1)
    (princ)
  );end_defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @selecao ()
    (print "ADD OBJETO")
    (setq ss (ssget))
    (if ss
      (progn
        (setq ctd 0)
        (repeat (sslength ss)
          (setq sname (ssname ss ctd))
          (setq ent (entget sname))
          (setq tipo (cdr (assoc 0 (entget (ssname ss ctd)))))
          (@SOMArco)
          (@OMAlinha)
          (setq ctd (1+ ctd))
        )
      )
      (alert "Nenhuma OBJ selecionada !!!")
    );end_if
  );end_defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @individual ()
    (while (setq ss (entsel (strcat "\nADD LINHAS :")))
      (if ss
        (progn
          (setq sname (car ss))
          (setq ent (entget (car ss)))
          (setq tipo (cdr (assoc 0 ent)))
          (redraw sname 3)
          (@SOMArco)
          (@OMAlinha)
        )
      );end_if
    );end_while
  );end_defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @SOMAlinha ()
    (cond ( (or (= tipo "POLYLINE") (= tipo "LWPOLYLINE"))
            (command "area" "o" sname)
            (setq SOMAlinha (+ soma (getvar "perimeter")))
          )
          ( (= tipo "LINE")
            (setq pt1 (cdr (assoc 10 ent)))
            (setq pt2 (cdr (assoc 11 ent)))
            (setq SOMAlinha (+ soma (distance pt1 pt2)))
          )
    );end_cond
  );end_defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun @SOMArco ()
    (cond ( (or (= tipo "CIRCLE") (= tipo "SPLINE") (= tipo "ELLIPSE"))
            (command "area" "o" sname)
            (setq SOMArco (+ SOMArco (getvar "perimeter")))
          )
          ( (= tipo "ARC")
            (setq raio (cdr (assoc 40 ent)))
            (setq ang1 (cdr (assoc 50 ent)))
            (setq ang2 (cdr (assoc 51 ent)))
            (if (< ang1 ang2)
              (setq rad (- ang2 ang1))
              (setq rad (+ (* 2 PI) (- ang2 ang1)))
            );end_if
            (setq comp (* raio rad))
            (setq SOMArco (+ SOMArco comp))
          )
    );end_cond
  );end_defun
  
  (setq old-error-sl *error*)
  (setq *error* @Error_sl)
  (setq SOMArco 0)
  (setq SOMAlinha 0)
  (if (not old-sel)
    (progn
      (initget "S I")
      (setq sel (getkword "\nTipo de seleção (Seleção / Individual) : "))
      (if (not sel)
        (progn
          (setq sel "S")
          (setq old-sel "S")
        )
        (setq old-sel sel)
      );end_if
    );end_progn
    (progn
      (initget "S I")
      (setq sel (getkword (strcat "\nTipo de seleção (Seleção / Individual) <" old-sel ">: ")))
      (if (not sel)
        (setq sel old-sel)
        (setq old-sel sel)
      );end_if
    );end_progn
  );end_if
  
  (cond ( (= sel "S") (@selecao))
        ( (= sel "I") (@individual) (command "._regen"))
  );end_cond
  ;;CHECK BELOW IS CORRECT. THE ERROR WAS HERE SOMEWHERE 
  (if SOMArco
    (progn
      (alert (strcat "COMPRIMENTO NÃO LINEAR" (rtos SOMArco 2 4)))
      (print (strcat "COMPRIMENTO NÃO LINEAR: " (rtos SOMArco 2 4)))
    )
    (if SOMAlinha
      (progn
        (alert (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4)))
        (print (strcat "COMPRIMENTO LINEAR: " (rtos SOMAlinha 2 4)))
      )
    );end_if
   (setvar "cmdecho" 1)
   (princ)
  );end_if
 (princ)
);end_defun

RED = CHECK CORRECT

[dlanorh · Accepted solution]

Ignore above.

Attached works. Please check.

[dlanorh · Accepted solution]

@rolisonfelipe 

Attached is updated lisp. All variables are now localised.

You will need to translate some alerts and the error message if you so desire.

Enjoy.

[rolisonfelipe]

@Anonymous, fantastic solution, I am not programmer, not to overload the friends who dedicate part of their time to help us, I try to reassemble lisp already existent, and already thanks for the immense help, but still this lsp, needs a correction , because the polyline element is naturally composed of rows and arcs and now how to eliminate it?
obs02 .. I will proceed in other routines one that helps to add dimension and implement in this routine

[dlanorh]

---

@rolisonfelipe wrote:

fantastic solution, I am not programmer, not to overload the friends who dedicate part of their time to help us, I try to reassemble lisp already existent, and already thanks for the immense help, but still this lsp, needs a correction , because the polyline element is naturally composed of rows and arcs and now how to eliminate it?
obs02 .. I will proceed in other routines one that helps to add dimension and implement in this routine

---

Not sure I fully understand. I think you want to know the length of arc segments in lwpolylines. Is that correct? That is not too difficult, since the start of every straight segment has a 0.0 bulge factor, and the start of every arc segment a non zero bulge factor. it would be a simple extra step to collect these seperately.

[rolisonfelipe]

PRESENTATION 01 OK - THE LSP WORKS VERY WELL WITH THE ARC AND LINES ELEMENTS, BUT IN THE PRESENTATION 02 ERROR, IT DOES NOT DIFFER THE ARC ELEMENTS AND LINES OF POLYLINE, THEN I HAVE ANOTHER ROUTINE THAT SERVES TO ADD AZIMUTE THAT IN A YE ADD  DISTANCE FROM EACH SEGMENT, AND WHEN IT ARRANTS IN THE ARC CONCORDANCE FOLLOWING IT CALCULATES THE VECTOR OF THE FINAL AND START OF THE NEXT LINE. THAT IS THE DESIRED FUNCTION FOR THIS LISP.
THAT TO SIT THE OBJECTS SEPARATELY AND AFTER HE ADD THE VALUES OF THE OBJECTS.
FROM THANK YOU FOR YOUR DEDICATION, HAVE A GOOD DAY.

[dlanorh · Accepted solution]

Attached are updated SMC.lsp and Label5.lsp

Try label5.lsp. I think it may do almost what you want. I have disabled the creation and setting of the text style, layer and text size for the labels. It will place the text in the current layer, in the current style at the current text size.

For the Azimuth it assumes that 0 degrees is North and angles are set to clockwise. These are set and the old settings restored on exit/error.

[rolisonfelipe]

Hello, @ dlanorh.
The Lisp SMC2 still does not sum separately the line and ARC components of the Pricipal object of polyline thus generating a sum in the objects with arches within the LINEAR variable where the polyline reading schedule presented a larger report than the Expected.
The Label5 is exactly what I need, it shows the distance correctly in the objects of arc, however it is unnecessary the azimutes, because it is necessary only the LABEL of the site.
Since I thank you for the dedication.

[F.Camargo · Accepted solution]

---

@rolisonfelipe wrote:

Hello, @ dlanorh.
The Lisp SMC2 still does not sum separately the line and ARC components of the Pricipal object of polyline thus generating a sum in the objects with arches within the LINEAR variable where the polyline reading schedule presented a larger report than the Expected.
The Label5 is exactly what I need, it shows the distance correctly in the objects of arc, however it is unnecessary the azimutes, because it is necessary only the LABEL of the site.
Since I thank you for the dedication.

---

(vl-load-com)
(defun c:label1 ( / *error* c_doc spc sv_lst sv_vals nw_style nw_font htx ss o_type pr pt_start pt_end seg_len seg_bulge rad alpha m_pt t_ang t_str nw_obj ll ur att_pt t_width)
                           
	(defun *error* ( msg )
		(mapcar 'setvar sv_lst sv_vals)
		(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
		(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : " msg " occurred.")))
		(princ)
	);end_*error*_defun
	
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        spc (if (= 1 (getvar 'cvport))
                (vla-get-paperspace c_doc)
                (vla-get-modelspace c_doc)
            );end_if
				sv_lst (list 'osmode 'cmdecho 'angdir 'angbase )
        ;sv_lst (list 'osmode 'cmdecho 'angdir 'angbase 'textstyle 'textsize);;system variable names list
				sv_vals (mapcar 'getvar sv_lst);;get current values
  );end_setq
;  (cond ( (null (tblsearch "LAYER" "DIMENSIONS")) (vlax-put (vla-add (vla-get-layers c_doc) "DIMENSIONS") 'color 7)))
;  (cond ( (null (tblsearch "STYLE" "ELEV_ARIAL_1"))
;          (setq nw_style (vla-add (vla-get-textstyles c_doc) "ELEV_ARIAL_1")
;                nw_font (strcat (getenv "systemroot") "\\Fonts\\Arial.ttf")
;          );end_setq
;          (mapcar '(lambda (pr val) (vlax-put-property nw_style pr val))
;            (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
;            (list nw_font 0.0 (/ (* 0.0 pi) 180) 1.0 0.0)
;          );end_mapcar
;        )
;  );end_cond
  (mapcar 'setvar sv_lst (list 0 0 1 90.0))
;  (initget 6)
;  (setq htx (getreal (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) "> : ")))
;  (if (not htx) (setq htx (getvar 'textsize)))

;  (mapcar 'setvar sv_lst (list 0 0 "ELEV_ARIAL_1" htx)); give them the values you want

	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(vla-startundomark c_doc)

  (prompt "\nSelect polylines : ")
  (while (null (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelection is Empty. Selected Items were not LWPolylines!")
  );end_while
   
  (vlax-for obj (vla-get-activeselectionset c_doc)
    (setq pr -1.0)
    (repeat (fix (vlax-curve-getendparam obj))
      (setq pr (1+ pr)
            pt_start (vlax-curve-getpointatparam obj pr)
            ;pt_end (vlax-curve-getpointatparam obj (1+ pr))
            seg_len (- (vlax-curve-getdistatparam obj (1+ pr)) (vlax-curve-getdistatpoint obj pt_start))
            seg_bulge (vla-getbulge obj pr)
            ;rad (if (zerop seg_bulge) 0.0 (abs (/ seg_len (* 4.0 (atan seg_bulge)))))
            ;alpha (if (zerop seg_bulge) (angle (trans pt_start 0 1) (trans pt_end 0 1)) 0.0)
            m_pt (vlax-curve-getpointatparam obj (+ 0.5 pr))
            alpha (angle '(0 0 0) (vlax-curve-getfirstderiv obj (+ 0.5 pr)))
            t_ang alpha
      );end_setq
      (if (< (/ pi 2) t_ang (* (/ pi 2) 3)) (setq t_ang (+ t_ang pi)))
      (if (= seg_bulge 0.0)
        (setq t_str (rtos seg_len 2 2))
        (setq t_str (rtos seg_len 2 2)) 
      );end_if
      (setq nw_obj (vla-addmtext spc (vlax-3d-point m_pt) 0.0 t_str))
      (vla-getboundingbox nw_obj 'll 'ur)
      (setq ll (vlax-safearray->list ll)
            ur (vlax-safearray->list ur)      
            t_width (+ (* (distance ll ur) (cos (angle ll ur))) 5.0)
      );end_setq
      (if (>= t_width seg_len)
        (setq att_pt 5
              t_width seg_len
        );end_setq
        (setq att_pt 8
              m_pt (polar m_pt (+ t_ang (/ pi 2)) (* (getvar 'textsize) 0.5))
        );end_setq
      );end_if        

      (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
        ;(list 'AttachmentPoint 'Insertionpoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'Width)
        ;(list att_pt m_pt (getvar 'textsize) 5 "ELEV_ARIAL_1" "DIMENSIONS" t_ang t_width)
        (list 'AttachmentPoint 'Insertionpoint 'Height 'DrawingDirection 'Rotation 'Width)
        (list att_pt m_pt (getvar 'textsize) 5 t_ang 0.0)
      );end_mapcar
    );end_repeat
  );end_for
;  (mapcar 'setvar sv_lst sv_vals)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

Apenas tirei o texto "AZ - " que você não deseja.

O código é do @dlanorh . Muito Bom!!!

Espero ter ajudado

Fabrício

[dlanorh · Accepted solution]

Attached are the updated lisps

SMC2.lsp now works properly. I didn't allow for negative bulges.

LABEL5.lsp now reports only the distances

[rolisonfelipe]

O ENTENDIMENTO FOI PERFEITO, NAO QUERENDO ABUSAR DA SUA BOA VONTADE, TEM COMO COLOCAR UMA VARIAVEL DE CONTRAOLAR A ALTURA DO TEXTO COMO NESTA LSP..... ESSA LISP CALCULA ÁREA MAS PERMITE CONTROLAR ALTURA......

DESDE JA AGRADEÇO PELA AJUDA...

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(DEFUN C:AS (/)                                                          
;
(IF (NOT XESCALA) (SETQ  XESCALA  50.0) )
(SETQ  XUNIDADE 1000)
(setq  TEXTO "\n ESCALA DO TEXTO = 1:")
(setq  ULTIMO  XESCALA)
(setq  XESCALA (getreal (strcat  TEXTO "<" (rtos ULTIMO 2 0) ">")))
(if (= XESCALA  nil)    (setq    XESCALA  ULTIMO))
;
(SETQ R-OSMODE (GETVAR "OSMODE"))
;
(SETVAR "CMDECHO" 0)
(SETVAR "DIMZIN"  0)
(SETVAR "OSMODE"  0)

(COMMAND "_LAYER" "_M" "ÁREA" "_C" "7" "ÁREA" "")
(COMMAND "_STYLE" "ARIAL" "ARIAL" "" "" "" "" "")

(SETQ AREAT 0)

(SETQ PINS (GETPOINT "\n INFORME UM LOCAL PARA CALCULO DE ÁREA = "))

(WHILE PINS
  (COMMAND "_-BOUNDARY" PINS "")
  (COMMAND "_AREA" "_O" "_L")
  (ENTDEL  (ENTLAST))

  (SETQ ATXT   (* 2.0 (/ XESCALA XUNIDADE)))
  (SETQ AREAC  (GETVAR  "AREA"))
  (SETQ AREAT  (+ AREAT AREAC))
  (SETQ TEXTO1 (STRCAT  "ÁREA = " (RTOS AREAC 2 2) "m²"))
  (SETQ TEXTO2 (STRCAT  "ÁREA = " (RTOS AREAC 2 2) "m² *** TOTAL = " (RTOS AREAT 2 2) "m²"))
  (COMMAND "_TEXT" "_M" PINS  ATXT "0" TEXTO1)
  (PRINT TEXTO2)

  (SETQ PINS (GETPOINT "\nINFORME UM LOCAL PARA CALCULO DE ÁREA = "))
)
(SETVAR "CLAYER" "0")
(SETVAR "OSMODE" R-OSMODE)
;
(PRINC)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC)