Jump to content

boundary that automatically adds the value of numbers of 5 specific layers

DAVID_OJEDA

By DAVID_OJEDA
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
Posted

Good morning everyone.

I need your help with a lisp, I don't know if it exists or can be done. I am not a programmer. Where I can generate a closed polygon with many vertices and at the same time add the numbers, and insert the total of the sum of 5 possible layers contained in that boundary.   layers names 1,2,  3,  4 , 5. Can be changed later.

 

THANKS, I HOPE YOU CAN HELP ME

1.PNG

BIGAL Grand Master

BIGAL

Posted
Posted

I have done it but need your dwg to check what I have works, like others they will have an answer as well but need a dwg to see if its text or block attributes.

 

Ps Lee-mac text readable lisp will turn text right way up.

DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
  • Author
Posted

thank you for your help Mr. Bigall. I would be pleased to attach a CAD file and briefly detail my request.

EXAMPLE.dwg

BIGAL Grand Master

BIGAL

Posted
Posted

Try this

  

(defun c:wow ()
(setq tot 0.0)
(setvar 'clayer "66. COBERTURA NAP")
(setq ent (car (entsel "\nPick pline ")))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (cons (last co-ord) co-ord))
(setq ss (ssget "WP" co-ord (list (cons 0 "TEXT,MTEXT")(cons 8 "10. NUMERO DE CASAS ALIMENTADAS,12. NUMERO DE COMERCIOS ALIMENTADOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,15. NUMERO DE COMERCIOS ALIMENTADOS EN EDIFICIOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,49. NUMERO DE DEPARTAMENTOS EN EDIFICIOS PROYECTADOS,50. NUMERO DE COMERCIOS EN EDIFICIOS PROYECTADOS,51. NUMERO DE  LOTE BALDIO"))))
(repeat (setq x (sslength ss))
(setq txtnum (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
(setq tot (+ tot txtnum))
)
(command "text" (getpoint "Pick point for text ") 3.0 0.0 (rtos tot 2 0))
(princ)
)
(c:wow)

 

DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
  • Author
Posted

Hi bigal. the routine does not work, it marks the following error: Pick pline ; error: wrong argument type: lselsetp nil. 

I am infinitely grateful for your support and effort but it is not exactly what I need. I need to make the polygon vertex by vertex selecting the points that in my opinion are the correct ones, until I close the polyline and when I close it automatically I could insert the text with the result of the sum. 

 

I work with this lisp, which you did me the favor of modifying. But it is not fully functional.  I want to have more control between the amounts I have to add.

 

 

  

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

 

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Ok I dont think you mentioned that you want to pick points, that makes it even easier. Will modify other code that I tested.

 

I needed to replace this (setq ent (car (entsel "\nPick pline "))) with make a list of point then make a pline and get sum of text.

  

(defun c:wow ( / lwpoly tot co-ord ent ss txtnum lstpl)

(defun LWPoly (lst cls)
 (entmakex (append 
    (list (cons 0 "LWPOLYLINE")
    (cons 100 "AcDbEntity")
    (cons 100 "AcDbPolyline")
    (cons 90 (length lst))
    (cons 70 cls))
    (mapcar (function (lambda (p) (cons 10 p))) lst))
  )
)
  
(setq tot 0.0)
(setq lstpl '())
(setvar 'clayer "23. PLANO BASE")

(while (setq pt (getpoint "\nPick points press Enter to exit"))
  (setq lstpl (cons pt lstpl))
)

(lwpoly lstpl 1)

(setq ent (entlast))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (cons (last co-ord) co-ord))
(setq ss (ssget "WP" co-ord (list (cons 0 "TEXT,MTEXT")(cons 8 "10. NUMERO DE CASAS ALIMENTADAS,12. NUMERO DE COMERCIOS ALIMENTADOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,15. NUMERO DE COMERCIOS ALIMENTADOS EN EDIFICIOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,49. NUMERO DE DEPARTAMENTOS EN EDIFICIOS PROYECTADOS,50. NUMERO DE COMERCIOS EN EDIFICIOS PROYECTADOS,51. NUMERO DE  LOTE BALDIO"))))

(repeat (setq x (sslength ss))
  (setq txtnum (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
  (setq tot (+ tot txtnum))
)

(setvar 'clayer "66. COBERTURA NAP")
(command "text" (getpoint "Pick point for text ") 3.0 0.0 (rtos tot 2 0))

(princ)
)
(c:wow)

 

If I get time will do version 2 where lines are drawn as you pick points so don't double up or miss last point.

Edited by BIGAL
DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
  • Author
Posted

Thanks my friend. you are wonderful. The second version would be great to visualize the points where the polyline is drawn.

 

Cordial greetings from the navel of the world. Mexico.

BIGAL Grand Master

BIGAL

Posted
Posted

Just making sure what I provided is working ok ? Will then add draw pline as pick points.

DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
  • Author
Posted

It works correctly, but it would be perfect if it allows you to visualize the contour of the polyline, by the points or vertices that you want to select.

BIGAL Grand Master

BIGAL

Posted
Posted

Try this

  

(defun c:5blks ( / tot co-ord ent ss txtnum)
(setq tot 0.0)
(setvar 'clayer "66. COBERTURA NAP")
(command-s "Pline")
(setq ent (entlast))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq co-ord (cons (last co-ord) co-ord))
(setq ss (ssget "WP" co-ord (list (cons 0 "TEXT,MTEXT")(cons 8 "10. NUMERO DE CASAS ALIMENTADAS,12. NUMERO DE COMERCIOS ALIMENTADOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,15. NUMERO DE COMERCIOS ALIMENTADOS EN EDIFICIOS,14. NUMERO DE DEPARTAMENTOS ALIMENTADOS,49. NUMERO DE DEPARTAMENTOS EN EDIFICIOS PROYECTADOS,50. NUMERO DE COMERCIOS EN EDIFICIOS PROYECTADOS,51. NUMERO DE  LOTE BALDIO"))))
(repeat (setq x (sslength ss))
  (setq txtnum (atof (cdr (assoc 1 (entget (ssname ss (setq x (1- x))))))))
  (setq tot (+ tot txtnum))
)
(command "text" (getpoint "Pick point for text ") 3.0 0.0 (rtos tot 2 0))
(princ)
)
(c:5blks)

 

  • Like 1
DAVID_OJEDA Apprentice

DAVID_OJEDA

Posted
  • Author
Posted

Good morning. I send you a cordial greeting. It adds perfectly, but when I draw the last vertex and hit enter to close the polyline, it leaves the polygon open.

 

apart from this detail, it works great. 

Thank you very much for your time and help.

BIGAL Grand Master

BIGAL

Posted
Posted

Do you type C to stop adding points ? The C option will end the pline command and close a Enter leaves open as you suggest.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...