Count text inside Closed polyline

[subodh_gis]

Can we count text or block inside the closed polyline using Autolisp.

[MSasu]

Yes - retrieve the list of vertexes of said boundary polyline (ASSOC) and create a selection set using SSGET with Fence mode; don't forget to filter for desired entities (*TEXT and/or INSERT). Use SSLENGT to count your selection set or parse it for a more detailed result.

This will work well if the polyline is made by only straight segments; if there are arc ones will need to refine the Fence path by adding extra points on curved parts.

[subodh_gis]

I m new to Lisp can you just code it to me.

[mostafa badran]

you can use this for text.

(defun c:txt(/ CNTXT GTXT TXTC)
 (setq gtxt(ssget '((0 . "text"))))
 (setq cntxt(sslength gtxt))
 (setq txtc(strcat "count of text = "(rtos cntxt)))
 (alert txtc)
 (princ)
)

and this for block.

(defun c:blk(/ BLKC CNBLKT GTBLK)
 (setq gtblk(ssget '((0 . "insert"))))
 (setq cnblkt(sslength gtblk))
 (setq blkc(strcat "count of block = "(rtos cnblkt)))
 (alert blkc)
 (princ)
)

[marko_ribar]

Yes - retrieve the list of vertexes of said boundary polyline (ASSOC) and create a selection set using SSGET with Fence mode; don't forget to filter for desired entities (*TEXT and/or INSERT). Use SSLENGT to count your selection set or parse it for a more detailed result.

This will work well if the polyline is made by only straight segments; if there are arc ones will need to refine the Fence path by adding extra points on curved parts.

 

Not sure ab Fence mode, but I would surely use either Window Polygon or Crossing Polygon...

 

M.R.

[jdiala]

Change the "insert" to count for text.

 

(defun c:test (/ e)
(if 
  (= (cdr (assoc 0 (setq e (entget (car (entsel "Pick a polyline:")))))) "LWPOLYLINE")
  (alert 
    (strcat "Number of blocks inside of polyline:   " 
      (itoa  
        (sslength
          (ssget "_WP" 
            (mapcar 
              (function 
                (lambda (x) (cdr x))
              ) 
              (vl-remove-if-not 
                (function 
                (lambda (x) (= (car x) 10))) e)
            ) '((0 . "[color="red"]INSERT[/color]"))))
      )
     )
   )
 )
)

[fixo]

Agreed, Marco

Here is one from my oldies:

(defun C:SIPL(/ *error* adoc choose cnt dis dp ent ep flag leg num pick pts sel sset )
 ;; fixo () 2010 
 ;; select inside curve 
 ;; edited 10/28/13 
(defun *error* (msg)
   (if adoc
     (vla-endundomark adoc)
   )
   (cond ((not msg))
         ((member msg '("Function cancelled" "quit / exit abort")))
         ((princ (strcat "\n** Error: " msg " ** ")))
   )
   (princ)
 ) 
(or adoc
     (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
       )
    )
     )
(vla-startundomark adoc)
     
 (setq choose nil)
 (while ( not choose )
   (setq sel    
     (entsel
       "\nSelect Curve to select objects inside: "
     )
   )
   
   (if sel 
     (setq choose
     (wcmatch
       (cdr (assoc 0 (entget (setq ent (car sel)))))
       "*LINE,ARC,CIRCLE,ELLIPSE"
     )
     )
   )
   (cond
     (
      (not choose)
      (princ
 "\nNothing or invalid object selected. Select single Curve object only!\n"
      )
     )
   )
 )
(setq pick (apply 'vlax-curve-getclosestpointto sel))
(setq flag (vl-catch-all-error-p
     (vl-catch-all-apply 'vlax-curve-isclosed (list ent))))
(setq leg
(cond ((vl-catch-all-error-p
   (setq ep
   (vl-catch-all-apply 'vlax-curve-getendparam
     (list ent)))
   )
     nil
 )
     ((vlax-curve-getdistatparam ent ep)
   )
))
(initget 7)
(setq num (getint "\nNumber of divisions along curve (>= 200): "))
 (setq dis (if flag
       (/ leg num)
       (/ leg (1- num))))
     
   
(setq cnt 0)
 (repeat num
   (setq dp  (trans (vlax-curve-getclosestpointto ent
        (vlax-curve-getpointatparam  ent
 (vlax-curve-getparamatdist ent (* dis cnt)))) 0 1))
   (setq pts (cons (reverse (cdr (reverse dp))) pts))
   (setq cnt (1+ cnt))
   )
(setq pts(reverse pts))
 (if 
 (setq sset (ssget "WP" pts '((0 . "TEXT")))); might be different filter: "TEXT,MTEXT,INSERT" etc 
 (progn
   (alert (strcat "Selected: " (itoa (sslength sset)) " objects.\nDo your rest job after.")))
 
     )
(*error* nil)
(princ)
)
(princ "\n\t---\tStart command with \"SIPL\"\t---")
(princ)
(or (vl-load-com)
   (princ))

[BIGAL]

An extra I will have to find it but pretty sure posted code here for text inside plines may be 12 months old like above uses the "WP" with polygon option to find text.

 

found

(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
) ; end defun

; program starts here
; choose output file change acdatemp to what you want
(setq fname (strcat "c:/acadtemp/" (getstring "\nEnter file name ")))
(setq fout (open fname "w"))

(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)

(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
(co-ords2xy)
; write pline co-ords here
(setq numb3 (length co-ords))
(setq z numb3)
(setq ansco-ords "")
(repeat numb3 
(setq ansco-ords (strcat ansco-ords (rtos (nth (setq z (- z 1)) co-ords) 2 3 ) " " ))
)
(setq ans (strcat "Pline " ansco-ords))
(write-line ans fout)
(setq ansco-ords "")
(setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil) 
(princ "\nnothing inside")
(progn 
(setq coordsxy nil) ; reset for next time
(setq numb2 (sslength ss))
(setq y numb2)
(repeat numb2
(setq anstext (vlax-get-property (vlax-ename->vla-object (ssname ss (setq y (- y 1)))) "Textstring"))
(princ anstext) ; change to write text to file
(write-line (strcat "text " anstext) fout)
(princ "\n")
) ; end repeat2
(setq ss nil) ; reset for next poly
)
)
) ; end repeat1
(close fout)
(princ)