HELP I NEED TO JOIN TWO ROUTINES TO SIMPLIFY A PROCESS

[DAVID_OJEDA]

Greetings. I need your help. I have two Lisp routines that I found in these forums, one that selects texts or multitexts inside a closed polyline and another one that adds numeric texts. Currently I do both processes: first select and then add. I want the two routines to join so that with a single command I get the desired result. thanks for your attention and help me. I am not a programmer and I don't know how to do it. 

 

Rutine lisp N. 1  selecc text. 

(defun C:WPS ( / i elist at cmde cen rad p1 impl)
 (setq cmde (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq i 0 elist (entget (car (entsel "\nPick a bounding circle or polyline: ")))) 
 (setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384))
 (if (zerop (getvar "CMDACTIVE")) (progn (setq impl T)(command "_select")))
 (command "_wp") ; or _CP
 (if (= (cdr(assoc 0 elist)) "CIRCLE")
  (progn
  (setq cen (cdr (assoc 10 elist))
        rad (cdr (assoc 40 elist)) 
  )
  (repeat 90 ; 360/4  0.06981317=4*pi/180
   (setq p1 (polar cen (* i 0.06981317) rad)  i (1+ i))
;   (command "_POINT" (trans p1 0 1))
   (command (trans p1 0 1))
  )); else
  (repeat (length elist) 
   (setq at (nth i elist) i (1+ i))
;   (if (= (car at) 10) (command (cdr at)))
   (if (= (car at) 10) (command (trans (cdr at) 0 1)))
  )
 );if CIRCLE
 (command "")
 (setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384))
 (setvar "cmdecho" cmde)
 (if impl (progn (command "")(sssetfirst nil (ssget "_P"))))
 (princ)
)

 

Rutine lisp N. 2  Add  text  and multitext.

;|***********************************************
     rutina "stn" suma textos numericos,
     funciona con TEXT y MTEXT no editados 
     (No formateados).
  ***********************************************
  (c) by Prexem - Victor Adolfo Bracamonte - 2008
  ****       www.prexem.blogspot.com         ****
  ***********************************************|;
(defun c:stn (/ sel p h cant index e data val n listn sum res)
  (prompt
 "\nSeleccione textos numericos a sumar, que no hayan sido editados:"
  )
  (setq sel   (ssget '((0 . "MTEXT,TEXT")))
 p     (getpoint
  "\nDar punto de inserción para texto final:"
  )
 h     (getdist p "\nDar altura de texto:")
 cant  (sslength sel)
 index 0
  );setq
  (repeat cant
    (setq e (ssname sel index)
   data  (entget e)
   val   (cdr (assoc 1 data))
   n (atof val)
   listn (cons n listn)
   index (1+ index)
    );setq
  );repeat
  (setq sum (apply '+ listn))
  (setq res (rtos sum 2 2))
  (command "_.text" p h 0 res)
  (princ)
);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[BIGAL]

Very straight forward but is text a number only or a string with a number, makes a difference.

 

2nd question do the plines have arcs or is text basically in middle of pline.

 

Image would help.

[DAVID_OJEDA]

Thanks for the answer Bigal. To select the text enclosed in polygons I use two routines, "SWC" that select all the texts or mtext. enclosed in a polygon, circle or ellipse, done this action, I load the command "STN" to add all the numeric text. But I want the add action to be executed with a single process.

 

 

[pkenewell]

On 3/27/2023 at 10:52 PM, DAVID_OJEDA said:

Greetings. I need your help. I

 

 

@DAVID_OJEDA FYI - please review the Code Posting Guidelines. You can also edit your original post using the popup "..." menu in the upper right corner of the post. This just makes it more convenient to help and reduces the length of the post.

[BIGAL]

Post a before and after dwg.

[DAVID_OJEDA]

5 hours ago, BIGAL said:

Publicar un dwg antes y después.

WITH PLEASURE

SUM ALL TEXT_ FOR PLINE.dwg

[BIGAL]

Ok this is version 1 for plines with straights only. Ver 2 would add circles, ver 3 would add ellipses and ver 4 would add plines with arcs.

 

(defun c:wow ( / plent co-ord ss tot txt)
(setq plent (entsel "\nPick pline "))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(setq co-ord (cons (last co-ord) co-ord))
(setq ss (ssget "WP" co-ord '(( 0 . "*TEXT"))))
(setq tot 0.0)

(if (= ss nil)
  (alert "No text selected will now exit ")
  (repeat (setq x (sslength ss))
    (setq txt (cdr (assoc 1 (entget (ssname ss (setq x (1- x)))))))
    (setq tot (+ (atof txt) tot))
  )
)

(alert (strcat "Total is " (rtos tot 2 2 ) " for " (rtos (sslength ss) 2 0) " Items"))

(princ)
)
(c:wow)

I think this is being missed will fix next version.

Edited March 30, 2023 by BIGAL

[mhupp]

Here is ver2 and 4 also uses CP crossing or inside polyine instead of WP inside only.

 

;;----------------------------------------------------------------------------;;
;; Select Text Inside Polyline or Circle
(defun C:SI (/ SS ent SS1 listn res)
  (if (setq SS (ssget "_+.:E:S" '((0 . "*POLYLINE,CIRCLE")))) 
    (selectinside (ssname ss 0) 0.250)
  )
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS1)))
    (setq n (atof (cdr (assoc 1 (entget ent))))
          listn (cons n listn)
    )  
  )    
  (setq res (rtos (apply '+ listn) 2 2))
  (entmake (list (cons 0 "TEXT")(cons 10 (getpoint "\nDar punto de inserción para texto final:"))(cons 40 (getvar 'textsize))(cons 1  res)))
  (princ)
)
;;----------------------------------------------------------------------------;;
;; ssget "WP" doesn't work well with polylines with arcs. This fixes it.
(defun selectinside (ent x / obj v i ii x bulge seg lst cir div seg dist)
  (setq obj (vlax-ename->vla-object ent))
  (if (eq (vla-get-objectname obj) "AcDbCircle")
    (progn
      (setq cir (vlax-get-property obj 'Circumference))
      (if (> (setq div (fix (/ cir x))) 4)
        (setq seg (/ cir div) dist seg)
      )
      (while (< dist cir)
        (setq lst (cons (vlax-curve-getPointAtDist ent dist) lst))
        (setq dist (+ dist seg))
      )
    )
    (progn
      (setq v (vlax-curve-getEndParam obj) i 0)
      (while (< i v)
        (if (/= 0 (abs (vlax-invoke obj 'GetBulge i)))  ;pulled from lisp ronjonp linked
          (progn
            (setq ii 0)
            (if (>= (setq seg (fix (/ (- (vlax-curve-getDistAtParam obj (1+ i)) (vlax-curve-getDistAtParam obj i)) x))) 5)
              (repeat seg
                (setq lst (cons (vlax-Curve-GetPointAtParam obj (+ i ii)) lst))
                (setq ii (+ (/ 1.0 seg) ii))
              )
              (repeat 5
                (setq lst (cons (vlax-Curve-GetPointAtParam obj (+ i ii)) lst))
                (setq ii (+ 0.20 ii))
              )
            )
          )
        )
        (setq lst (cons (vlax-Curve-GetPointAtParam obj i) lst))
        (setq i (1+ i))
      )
      (setq lst (cons (vlax-Curve-GetPointAtParam obj i) lst))
    )    
  )
  (setq SS1 (ssget "_CP" lst '((0 . "*TEXT"))))
)

 

 

 

 

[DAVID_OJEDA]

On 30/3/2023 at 1:10, mhupp said:

Aquí está ver2 y 4 también usa CP crossing o inside polyine en lugar de WP inside only.

 

 

 

 

 

THANKS FOR YOU HELP.  THE FUNCTION OF SELECTION OF POLYGONS BY WINDOW OR CROSSING CAN BE ADDED. IT WOULD BE USEFUL TO SELECT POLYGONS THAT ARE NOT ISOLATED OR THAT ARE ATTACHED TO MORE POLYGONS.

[BIGAL]

This is a mod to  Mhupp code. 

 

; Original code by Mhupp
; Modified by AlanH April 2023
; sums text inside plines circles and ellipse

;;----------------------------------------------------------------------------;;
;; ssget "WP" doesn't work well with polylines with arcs. This fixes it.
;(defun C:sumtext ( / obj v i ii x bulge seg lst cir div seg dist ANG ANGSEG CEN CO-ORD CX CY ENT HT J PX PY SS SS1 SS2 TOT TXT WID)


(defun C:sumtext ( / )
(setq SS (ssget '((0 . "*POLYLINE,CIRCLE,ELLIPSE"))))
  (repeat (setq J (sslength ss))
  (setq ent (ssname ss (setq j (1- J))))
  (setq obj (vlax-ename->vla-object ent))
  
    (if (= (vla-get-objectname obj) "AcDbCircle")
    (progn
	  (setq cir (vlax-get-property obj 'Circumference))
      (setq seg (/ cir 40) dist 0.0 lst '())
      (while (< dist cir)
        (setq lst (cons (vlax-curve-getPointAtDist obj dist) lst))
        (setq dist (+ dist seg))
      )
    )
	)
	
	(If (= (vla-get-objectname obj) "AcDbPolyline")
    (progn
	(setq lst '())
      (setq v (vlax-curve-getEndParam obj) i 0)
      (while (< i v)
        (if (/= 0 (abs (vlax-invoke obj 'GetBulge i)))  ;pulled from lisp ronjonp linked
          (progn
            (setq ii 0)
            (if (>= (setq seg (fix (/ (- (vlax-curve-getDistAtParam obj (1+ i)) (vlax-curve-getDistAtParam obj i)) 0.25))) 5)
              (repeat seg
                (setq lst (cons (vlax-Curve-GetPointAtParam obj (+ i ii)) lst))
                (setq ii (+ (/ 1.0 seg) ii))
              )
              (repeat 5
                (setq lst (cons (vlax-Curve-GetPointAtParam obj (+ i ii)) lst))
                (setq ii (+ 0.20 ii))
              )
            )
          )
        )
        (setq lst (cons (vlax-Curve-GetPointAtParam obj i) lst))
        (setq i (1+ i))
      )
      (setq lst (cons (vlax-Curve-GetPointAtParam obj i) lst))
    )    
    )
	
    (If (= (vla-get-objectname obj) "AcDbEllipse")
    (progn
     (setq ang 0.0)
     (setq angseg (/ (* 2 pi) 40.))
     (setq cen (vlax-get obj 'center))
     (setq cx (car cen) cy (cadr cen))
      (setq wid (vlax-get obj 'MajorRadius))
      (setq ht (vlax-get obj 'MinorRadius))
      (setq lst '())
      (repeat 40
       (setq px (+ cx (* wid (cos ang))))
       (setq py (+ cy (* ht (sin ang))))
       (setq lst (cons (list px py) lst))
       (setq ang (+ ang angseg))
      )
    )
	)
	
(setq ss1 (ssget "WP" lst '((0 . "*TEXT"))))
(setq SS2 (ssget "F"  lst '((0 . "*TEXT"))))
(if (= ss2 nil)
  (princ)
  (repeat (setq jj (sslength ss2))
	(setq ss1 (ssadd (ssname ss2 (setq jj (1- jj))) ss1))
  )
)

(if (= ss1 nil)
  (alert "No text selected will now exit ")
  (progn
  (setq tot 0.0)
    (repeat (setq kk (sslength ss1))
      (setq txt (cdr (assoc 1 (entget (ssname ss1 (setq kk (1- kk)))))))
      (setq tot (+ (atof txt) tot))
    )
 ; (alert (strcat "Total is " (rtos tot 2 2 ) " for " (vla-get-objectname obj) " "  (rtos (sslength ss1) 2 0) " Items"))
  (entmake (list (cons 0 "TEXT")(cons 10 (getpoint (car lst) "\nDar punto de inserción para texto final:"))(cons 40 (getvar 'textsize))(cons 1 (rtos tot 2 2) )))
  )
)

)
(princ)
)
(c:sumtext)

 

Edited April 2, 2023 by BIGAL

[DAVID_OJEDA]

Mr. Bigal, Mr. Mhupp. they did an excellent job. It works like a charm. Thanks for your help.

[BIGAL]

Glad to here it worked out big help though from Mhupp.