Jump to content

I need lisp upgrade, HELP! :)


djx084

Recommended Posts

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

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 5 years later...
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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

Link to comment
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
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.

×
×
  • Create New...