Jump to content
djx084

I need lisp upgrade, HELP! :)

Recommended Posts

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 by rkmcswain
added [CODE] tags

Share this post


Link to post
Share on other sites
djx084

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

Share this post


Link to post
Share on other sites
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)
               )
           )
       )
   )
)

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
Commandobill

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

Share this post


Link to post
Share on other sites
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"))

Share this post


Link to post
Share on other sites
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"))

Share this post


Link to post
Share on other sites
djx084

Ok,exelent, tnx! [emoji106]

Share this post


Link to post
Share on other sites
djx084

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

Share this post


Link to post
Share on other sites
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?

 

 
 
 

image.png

Untitled.jpg

UpisP.lsp

Share this post


Link to post
Share on other sites
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...

1.jpg

1p.dwg

Share this post


Link to post
Share on other sites
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..)
 

image.png

Share this post


Link to post
Share on other sites
djx084

Share this post


Link to post
Share on other sites
djx084

f5

 

Share this post


Link to post
Share on other sites
djx084

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

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...