Extracting Labels, Areas and L

badeas · 发表于 2022-7-5 23:32:41

Hello all, i am new on cadTutor, hey there first

I am looking for a lisp, or a vba macro, to get area and length values of polylines with their texts which are written inside a closed polyline, like>

Label----------------Area(m2)-------Length (m)
Security Room-------25,36-------------21,12

let me tell you what i want,

on an architectural project there are room labels inside room polylines, and im taking all polylines one-by-one and writing their labels, areas and lengths to excel. i want to fasten my work. can you help me with this?

I searched cadTutor forum for this, but i couldnt find. DATAEXTRACTION can't take texts inside polylines as labels by the way.

TY
Sincerely Yours,

pBe · 发表于 2022-7-5 23:47:37

Welcome the CADTutor Badeas

This is eerily similar to what i just posted at another forum

copy

(defun c:ShowMe        (/ strnum _outside-p text ss Pline Txtinside i e entdata spc)(defun strnum (var val str / p) (setq p str) (repeat (- val (strlen var)) (setq p (strcat str p))) (strcat var p))  (defun _outside-p (pt ent / YoRay len);;;                pBeFeb20014                                ;;;;;; http://en.wikipedia.org/wiki/Point_in_polygon        ;;;;;;                  even-odd rule                                ;;;   (setq YoRay   (entmakex (list               '(0 . "RAY")               '(100 . "AcDbEntity")               '(100 . "AcDbRay")               (cons 10 pt)               '(11 1.0 0.0 0.0)             )   )   )   (setq len (/  (length (vlax-invoke                (vlax-ename->vla-object YoRay)                'intersectwith                ent                acextendnone              )      ) 3)   )   (entdel YoRay)   (zerop (rem len 2)) ) (if (setq text      nil    Pline     nil    Txtinside nil    ss              (ssget "_X"                     (list '(-4 . "")                           (cons 410 (getvar 'ctab))                     )              )     )   (progn     (repeat (setq i (sslength ss))(setq e        (vlax-ename->vla-object (ssname ss (setq i (1- i)))))(if (eq "AcDbText" (vla-get-ObjectName e))  (setq text (cons (list e (vlax-get e 'InsertionPoint)) text))  (setq Pline (cons e Pline)))     )     (foreach itm text(if (setq hit (vl-some '(lambda        (pl)                          (if (not (_outside-p (Cadr itm) pl))                            (list (car itm) pl)                          )                        )                       pline              )    )  (setq        Txtinside (cons hit Txtinside)  ))     )     (princ (strcat "\n" (strnum "Label" 20 "-")(strnum "Area" 20 "-") "Length"))     (princ (strnum "\n" 48 "*"))     (foreach tx Txtinside     (princ  (strcat "\n" (strnum (vla-get-textstring (Car tx)) 20 "-")                 (strnum (rtos (vla-get-area (cadr tx)) 2 2) 20 "-")                      (rtos (vla-get-length (cadr tx))))      )            )   ) )(princ))

This is [sTILL] just a demo. it shows the textstring DATA at the end of the routine

pBe · 发表于 2022-7-6 00:07:02

Here's another to process ALL Layout [Model/Paper space..]
Also Edit _outside-p to _inside-p and modify the code to use 'AddRay

copy

(defun c:ShowMe        (/ strnum _outside-p text ss Pline Txtinside i e entdata spc)(defun strnum (var val str / p) (setq p str) (repeat (- val (strlen var)) (setq p (strcat str p))) (strcat var p));;;                pBeFeb20014                                ;;;;;; http://en.wikipedia.org/wiki/Point_in_polygon        ;;;;;;                  even-odd rule                                ;;;(defun [color="blue"]_inside-p[/color] (pt ent [color="blue"]*spc*[/color] / YoRay len)[color="blue"] (setq        YoRay (vlax-invoke        (vlax-get *spc* 'Block)        'AddRay        pt        (polar pt 0 1)      ) )[/color] (setq        len (length (vlax-invoke YoRay              'intersectwith ent              acextendnone            )    ) ) (vla-delete YoRay) (not (zerop (rem len 2)))) (if (setq text      nil    Pline     nil    Txtinside nil    ss              (ssget "_X"                     '((-4 . "")                    )              )     )   (progn     (repeat (setq i (sslength ss))(setq e        [color="blue"](ssname ss (setq i (1- i))) spc (cdr (assoc 410 (entget e)))[/color])(if (eq "AcDbText" (vla-get-ObjectName [color="blue"](setq e (vlax-ename->vla-object e))[/color]))  (setq text (cons (list [color="blue"]spc[/color] e (vlax-get e 'InsertionPoint) ) text))  (setq Pline (cons [color="blue"](list sp[/color]c e[color="blue"])[/color] Pline)))     )     (foreach itm text[color="blue"](setq spc_ (car itm) itm (cdr itm))(setq pl_ (vl-remove-if-not '(lambda (l)                (eq (car l) spc_)) pline))(setq layc (vla-item (vla-get-layouts                       (vla-get-activedocument                         (vlax-get-acad-object)                       )                     )                     spc_           ))[/color](if (setq hit (vl-some '(lambda        (pl)                          (if (_inside-p (cadr itm) pl [color="blue"]layc[/color])                            (list (car itm) pl)                          )                        )                       [color="blue"](mapcar 'cadr pl_)[/color]              )    )  (setq        Txtinside (cons hit Txtinside)  ))     )     [color="blue"](textscr)[/color]     (princ (strcat "\n" (strnum "Label" 20 "-")(strnum "Area" 20 "-") "Length"))     (princ (strnum "\n" 48 "*"))     (foreach tx Txtinside     (princ  (strcat "\n" (strnum (vla-get-textstring (Car tx)) 20 "-")                 (strnum (rtos (vla-get-area (cadr tx)) 2 2) 20 "-")                      (rtos (vla-get-length (cadr tx))))      )            )   ) )(princ))

badeas · 发表于 2022-7-6 00:13:39

Sorry for my newb questions, but what can i do with these codes, i can't understand,

I copy and paste to a lisp file, and APPLOAD them on AutoCAD, and i command ShowME but nothing shows off.

Load of Thanks for fast replies btw.

pBe · 发表于 2022-7-6 00:26:57

Hows about you posting a sample drawing file.

Then i can tell you what to do badeas.

badeas · 发表于 2022-7-6 00:36:14

Hey there again, this is what i want to do with a lisp >

http://postimg.org/image/wuqgej667/

Thanks,

[编程交流] Extracting Labels, Areas and L

发表回复

精选推荐