CAD/CAM discussion forum > CAD Tutorial & Tips > lisp routine adjustment, use lisp routine to calculate area of polyline in cad

lisp routine adjustment, use lisp routine to calculate area of polyline in cad

    
  Subscribe Topic

Rank: 1

tony

Newbie

posts: 8

Registered: 2009-11-27

Message 1 of 3

 lisp routine adjustment, use lisp routine to calculate area of polyline in cad
22-11-2012 01:16 . am   |   View his/her posts only
hi,this is a lisp routine that calculates the area of a polyline and lets you place a text in the dwg.
I want this text to be justified middle center but i don't know how to.
Can anyone help me?
thanks!



;;;RET een entiteit (name) NA SELECTIE DMV MEERDERE OPGEGEVEN TYPES ENTITEITEN (e_type)
;;;e_prompt = te geven prompt
(defun sel_ents
(e_type e_prompt / aard ent)
(while (not (member aard e_type))
(while (not (setq ent (entsel e_prompt))))
(if
(not (member (setq aard (dxf 0 (entget (car ent)))) e_type))
(prompt

"\nIncorrect entiteit-type !"
)
)
)
ent
)

(defun dxf (code elist) (cdr (assoc code elist)))


(defun c:MS (/ el pt_e pt_wcs o
ha_ a_ ca_ $ lay col txt_hgt hk
zone

eed_l)

(if (setq ent
(sel_ents (list "LWPOLYLINE" "POLYLINE")

"\nSelecteer polyline: "

)
)
(progn
(setq el (entget (car ent)))
(if (@main-even (dxf 70 el))

(alert "Opgelet: polyline is niet gesloten !")
)
(command "_area" "_O" ent)
(setq $opp (strcat "Opp.= " (rtos (/ (getvar "AREA") 10000.0) 2 2) " m2"))
(setq $omtrek (strcat "Omtr.= " (rtos (/ (getvar "PERIMETER") 100.0) 2 2) " lm"))
(setq pt (getpoint "\nGeef positie tekst:"))
(@main_ent-mtext "MEETSTAAT" 8 (strcat "\n" $opp "\n" $omtrek) "A_25_50" pt 12.0 0.0 150.0 nil)
)
)
)



;;;MAAKT TEXT-ENTITEIT AAN
(defun @main_ent-mtext ($lay col str $style pt ht ang width ext_l / ent_list)
(@main_ent-textstyle $style)
(setq
ent_list
(list
(cons 0 "MTEXT")
'(100 . "AcDbEntity")
(cons 8 $lay)
(cons 62 col)

'(100 . "AcDbMText")
(cons 10 pt)
(cons 40 ht)
(cons 41 width)
(cons 1 str)
(cons 50 ang)
(cons 7 $style)
'(210 0.0 0.0 1.0)
)
)
(if ext_l
(setq ent_list (append ent_list (list (list -3 ext_l))))
)
(entmake ent_list)
)



(defun @main_ent-textstyle (style / ent_list)
(if (not (tblsearch "STYLE" style))
(setq
ent_list
(list

'(0 . "STYLE")

'(100 . "AcDbSymbolTableRecord")

'(100 . "AcDbTextStyleTableRecord")

(cons 2 style)

'(70 . 0)

'(40 . 0.0)

'(41 . 1.0)

'(50 . 0.0)

'(71 . 0)

'(42 . 2.5)

'(3 . "txt")

'(4 . "")
)
)
)
)


;;controleert of een getal even is
(defun @main-even (getal /)
(if (= getal 0)
T
(if
(= (gcd 2 getal) 2)
T
nil
)
)
)


(prompt "\nMeetstaat tool loaded.")
(princ)

Rank: 5Rank: 5

Daniel

posts: 278

Registered: 2012-6-6

Message 2 of 3

22-11-2012 10:53 . am   |   View his/her posts only
You can use this:
(setq
ent_list
(list
(cons 0 "MTEXT")
'(100 . "AcDbEntity")
(cons 8 $lay)
(cons 62 col)

'(100 . "AcDbMText")
(cons 10 pt)
(cons 40 ht)
(cons 41 width)
(cons 1 str)
(cons 50 ang)
(cons 7 $style)
(cons 71 5)
'(210 0.0 0.0 1.0)
)
)


Try ZWCAD+ free for 30 days:
http://www.zwsoft.com/zwcad/ZWCAD_Overview

Rank: 1

tony

Newbie

posts: 8

Registered: 2009-11-27

Message 3 of 3

22-11-2012 03:13 . pm   |   View his/her posts only
hi Daniel,
it works.
Thank you!
See also
X