Jump to content

Count text inside Closed polyline


subodh_gis

Recommended Posts

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)

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