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

Extracting Labels, Areas and L

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
 

(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 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
Also Edit _outside-pto _inside-p and modify the code to use 'AddRay
 

(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 _inside-p (pt ent *spc* / YoRay len) (setq        YoRay (vlax-invoke        (vlax-get *spc* 'Block)        'AddRay        pt        (polar pt 0 1)      ) ) (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        (ssname ss (setq i (1- i))) spc (cdr (assoc 410 (entget e))))(if (eq "AcDbText" (vla-get-ObjectName (setq e (vlax-ename->vla-object e))))(setq text (cons (list spc e (vlax-get e 'InsertionPoint) ) text))(setq Pline (cons (list spc e) Pline)))   )   (foreach itm text(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_           ))(if (setq hit (vl-some '(lambda        (pl)                          (if (_inside-p (cadr itm) pl layc)                          (list (car itm) pl)                          )                        )                     (mapcar 'cadr pl_)              )    )(setq        Txtinside (cons hit Txtinside)))   )   (textscr)   (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,
页: [1]
查看完整版本: Extracting Labels, Areas and L