I need lisp upgrade, HELP! :)

[djx084]

I have a lisp file and I would like to upgrade.

Using LISP I write my surface contours which selects the drawing.

Can be upgraded lisp that we entered more than one selected contours at once? maybe 20-30 contours at the same time ...

 

LISP

(defun C:UpisP ()
;  (setvar "cmdecho" 0)
 (setq VisT (getreal "\n <<<GEOS>> Velicina teksta: "))
 (setq BRDM (getint "\n Broj decimalnih mjesta: "))
 (setq POV1 0.0 DUZ1 0.0)
 (repeat 100
       (command "AREA" "o" (entsel))
       (setq POV1 (getvar 'AREA) DUZ1 (getvar 'PERIMETER))
       (setq T1 (getpoint "\n Pozicija teksta: "))
       (command "TEXT" t1 VisT "0" (strcat (rtos (getvar 'AREA) 2 BRDM)"m2"))
  )
 (princ)
)

Edited July 1, 2015 by rkmcswain
added [CODE] tags

[djx084]

[CafeJr]

It helps?...

 

Link to fill areas

 

Thanks to: GP_

[djx084]

something like that, but my lisp sets the font size, the number of decimal and enter area with square meters ...

[Commandobill]

How about this?

(defun C:UpisP ( / VisT BRDM ss)
;  (setvar "cmdecho" 0)
 (if (and
(setq VisT (getreal "\n <<<GEOS>> Velicina teksta: "))
(setq BRDM (getint "\n Broj decimalnih mjesta: "))
(setq ss (ssget '((0 . "LWPOLYLINE")))))
   (mapcar '(lambda (x)
 (entmake
                   (list
                       (cons 0 "TEXT")
                       (cons 8 (getvar "clayer"))
                       (cons 7 (getvar "textstyle"))
                       (cons 10 (LM:PolyCentroid x))
		(cons 11 (LM:PolyCentroid x))
                       
                       (cons 40 VisT)
                       (cons 72 1)
                       (cons 73 2)
                       (cons 1 (strcat (rtos (vlax-curve-getArea x) 2 BRDM) "m2"))
                   )
               ))
    (mapcar 'cadr (ssnamex ss))
           ))
 
 (princ)
)





;; Polygon Centroid  -  Lee Mac
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM:PolyCentroid ( e / l )
   (foreach x (setq e (entget e))
       (if (= 10 (car x)) (setq l (cons (cdr x) l)))
   )
   (
       (lambda ( a )
           (if (not (equal 0.0 a 1e-)
               (trans
                   (mapcar '/
                       (apply 'mapcar
                           (cons '+
                               (mapcar
                                   (function
                                       (lambda ( a b )
                                           (
                                               (lambda ( m )
                                                   (mapcar
                                                       (function
                                                           (lambda ( c d ) (* (+ c d) m))
                                                       )
                                                       a b
                                                   )
                                               )
                                               (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                                           )
                                       )
                                   )
                                   l (cons (last l) l)
                               )
                           )
                       )
                       (list a a)
                   )
                   (cdr (assoc 210 e)) 0
               )
           )
       )
       (* 3.0
           (apply '+
               (mapcar
                   (function
                       (lambda ( a b )
                           (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                       )
                   )
                   l (cons (last l) l)
               )
           )
       )
   )
)

[djx084]

How about this?

(defun C:UpisP ( / VisT BRDM ss)
;  (setvar "cmdecho" 0)
 (if (and
(setq VisT (getreal "\n <<<GEOS>> Velicina teksta: "))
(setq BRDM (getint "\n Broj decimalnih mjesta: "))
(setq ss (ssget '((0 . "LWPOLYLINE")))))
   (mapcar '(lambda (x)
 (entmake
                   (list
                       (cons 0 "TEXT")
                       (cons 8 (getvar "clayer"))
                       (cons 7 (getvar "textstyle"))
                       (cons 10 (LM[emoji14]olyCentroid x))
(cons 11 (LM[emoji14]olyCentroid x))
                       
                       (cons 40 VisT)
                       (cons 72 1)
                       (cons 73 2)
                       (cons 1 (strcat (rtos (vlax-curve-getArea x) 2 BRDM) "m2"))
                   )
               ))
   (mapcar 'cadr (ssnamex ss))
           ))
 
 (princ)
)





;; Polygon Centroid  -  Lee Mac
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM[emoji14]olyCentroid ( e / l )
   (foreach x (setq e (entget e))
       (if (= 10 (car x)) (setq l (cons (cdr x) l)))
   )
   (
       (lambda ( a )
           (if (not (equal 0.0 a 1e-)
               (trans
                   (mapcar '/
                       (apply 'mapcar
                           (cons '+
                               (mapcar
                                   (function
                                       (lambda ( a b )
                                           (
                                               (lambda ( m )
                                                   (mapcar
                                                       (function
                                                           (lambda ( c d ) (* (+ c d) m))
                                                       )
                                                       a b
                                                   )
                                               )
                                               (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                                           )
                                       )
                                   )
                                   l (cons (last l) l)
                               )
                           )
                       )
                       (list a a)
                   )
                   (cdr (assoc 210 e)) 0
               )
           )
       )
       (* 3.0
           (apply '+
               (mapcar
                   (function
                       (lambda ( a b )
                           (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                       )
                   )
                   l (cons (last l) l)
               )
           )
       )
   )
)

Yes,this is it, thank you very mach!

Is it possible to add some text above area ? For example

Room Room

12.35m2 2.14m2

[Commandobill]

Put an example picture or something to give me a better understanding of what you want.

[CafeJr]

Yes,this is it, thank you very mach!

Is it possible to add some text above area ? For example

Room Room

12.35m2 2.14m2

 

In simple way, change this line:

(cons 1 (strcat [color="blue"]"ROOM" " "[/color] (rtos (vlax-curve-getArea x) 2 BRDM) "m2"))

[Tharwat]

In simple way, change this line:

(cons 1 (strcat [color="blue"]"ROOM" " "[/color] (rtos (vlax-curve-getArea x) 2 BRDM) "m2"))

 

Or ...

 

(cons 1 (strcat [color="blue"]"ROOM "[/color] (rtos (vlax-curve-getArea x) 2 BRDM) "m2"))

[djx084]

Ok,exelent, tnx! [emoji106]

[djx084]

Thank you very much for the quick response and the help, you're the best!

[djx084]

hello, can someone help me about this lisp

 

(defun C:UpisP ( / VisT BRDM ss)
;  (setvar "cmdecho" 0)
  (if (and
    (setq VisT (getreal "\n <<<DJOLE>> Velicina teksta: "))
    (setq BRDM (getint "\n Broj decimalnih mjesta: "))
    (setq ss (ssget '((0 . "LWPOLYLINE")))))
    (mapcar '(lambda (x)
  (entmake
                    (list
                        (cons 0 "TEXT")
                        (cons 8 (getvar "clayer"))
                        (cons 7 (getvar "textstyle"))
                        (cons 10 (LM:PolyCentroid x))
            (cons 11 (LM:PolyCentroid x))
                        
                        (cons 40 VisT)
                        (cons 72 1)
                        (cons 73 2)
                        (cons 1 (strcat (rtos (vlax-curve-getArea x) 2 BRDM) "m²"))
                    )
                ))
        (mapcar 'cadr (ssnamex ss))
            ))
  
  (princ)
)

;; Polygon Centroid  -  DJOLE
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM:PolyCentroid ( e / l )
    (foreach x (setq e (entget e))
        (if (= 10 (car x)) (setq l (cons (cdr x) l)))
    )
    (
        (lambda ( a )
            (if (not (equal 0.0 a 1e-8))
                (trans
                    (mapcar '/
                        (apply 'mapcar
                            (cons '+
                                (mapcar
                                    (function
                                        (lambda ( a b )
                                            (
                                                (lambda ( m )
                                                    (mapcar
                                                        (function
                                                            (lambda ( c d ) (* (+ c d) m))
                                                        )
                                                        a b
                                                    )
                                                )
                                                (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                                            )
                                        )
                                    )
                                    l (cons (last l) l)
                                )
                            )
                        )
                        (list a a)
                    )
                    (cdr (assoc 210 e)) 0
                )
            )
        )
        (* 3.0
            (apply '+
                (mapcar
                    (function
                        (lambda ( a b )
                            (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                        )
                    )
                    l (cons (last l) l)
                )
            )
        )
    )
)

 

 

it sets my dimensions diagonally instead of in the middle of the room,  

what's wrong with the code or maybe the autocad setting?

 

 

 

 

UpisP.lsp

[tombu]

Couldn't see any lots or labels in your attached image.

Attach a small drawing of a lot with where the label is now and where you'd prefer it to be.

This link may be what you're looking for: http://www.cadtutor.net/forum/showthread.php?76645-Display-hatch-area-as-a-label&p=517683&viewfull=1#post517683

[djx084]

I've tried these lsp but they don't work properly for me.
I am sending you a drawing and a better picture with my lsp...

1p.dwg

[djx084]

does anyone have a suggestion? I have the impression that there is some little thing in the code, because sometimes on some drawings everything works properly (puts the value in the middle..)
 

[djx084]

[djx084]

f5

 

[djx084]

does anyone have a suggestion and can anyone take a look? 

[Roy_043]

Your plan is very far from the origin. This leads to inaccuracies in the calculation of the centroid.

: id
Select point to identify coordinates:
 X=6603203.81  Y=4643037.02  Z=0.00

BTW: You may want to explain this:

;; Polygon Centroid  -  Lee Mac

;; Polygon Centroid  -  DJOLE