LISP Request - Block Count Inside a Closed Polyline

[Anonymous]

Hi CAD Friends,

Wonder if there is a LISP routine (already created by someone) to count all the blocks inside a closed polyline.

These are typically plant blocks with attributes in it. I have these sheet layout boundaries in model space, and the City now wants the count of all the plant blocks in a particular sheet, and a totals count in the end. I was using BCOUNT, but then I have to select the blocks individually along the sheet boundaries carefully. Instead of that If I can select the polylines of these sheet boundaries, then the lisp should count and provide a total count of different types of blocks contained (all the blocks with the centre point inside that selected polyline) inside the closed polyline. 

If some one can modify the BCOUNT lisp adding an additional feature to count blocks inside the user selected closed polyline ( get input from user selecting the closed polyline), that would be awesome.

Regards,

VA

[Anonymous]

HI BeeKeeCZ,

Thank you sir for your help and support. I have tested your routine in quite a few situations, and so far this is working GREAT.I even tried a boundary made originally with spline and converted to polyline and it worked perfectly there as well. I really want to "Accept it as Solution" but want to do more tests by different cad users, so that the routine is thoroughly tested. I highly suggest the CAD gurus out here please test this with different situations so that the routine is comprehensive. I also want to test this in some real project drawings with Plant schedules so that the test is fool proof. Please give me a few more days until this crazy New Year drawing roll outs are complete.

Thank you guys for your help and support,

VA

[Anonymous]

Hi Kent1Cooper,

Thanks for your effort and guidance,

I tested your routine, and I guess this is not complete ( Just a partial routine to register the location of blocks in model space?) I can see it is making a temp. offset boundary, but it disappears after. But it is not returning any Block counts. and more over it is taking too much time to end the routine.

I guess I need more knowledge in programming to figure what you have intended to do with this BIB lisp.

Regards,

VA

[Kent1Cooper]

---

@Anonymous wrote:

.... I tested your routine, and I guess this is not complete ( Just a partial routine to register the location of blocks in model space?) I can see it is making a temp. offset boundary, but it disappears after. But it is not returning any Block counts. and more over it is taking too much time to end the routine.

....

---

As I said, it's only to identify which Blocks  have their insertion points inside the boundary object.  [And it should work with any  kind of Offsettable object with area as a boundary -- Polyline, Circle, Ellipse, Spline.  It will "function" even with an Arc or unclosed  Polyline/Ellipse/Spline, though results may sometimes be incorrect.]  It doesn't register their locations, but rather puts them into a selection set variable.  You can confirm whether it found the right ones, by [after running it] starting a command such as Move or Copy and typing in:

!insiders

[with the preceding exclamation point] for the object selection.  It will select/highlight/grip them, and you can hit Enter to complete the selection and then start Moving/Copying just to see clearly which ones it found, since the nature of the Blocks makes highlighting not obvious enough at certain Block scales or Zoom levels.  Then cancel without actually Moving/Copying them.

But you are correct -- it does not proceed past finding  them -- it was an attempt to get around the possible errors in finding the right Blocks that some other approaches such as crossing-polygon selection encountered.  Code for the counts, etc., exists elsewhere, and if those work better with a list of objects, rather than a selection set, the code could be altered very easily to put them in a list instead.

I do find it curious that some  of the Offset boundaries that it uses temporarily appear in the drawing briefly as it's working, but not all  of them.  It does draw  all of them, but some must appear and disappear so instantaneously that they're not noticeable.  All of them do disappear afterwards, because their only purpose is to compare areas, to decide whether or not a Block, through whose insertion point one was Offset, is inside the boundary.

As for the time to end it, I find that sometimes the cursor location sits there with the working-on-it symbol still showing, past  the time when it's actually finished, but just moving the mouse a little "clears" that back to the regular cursor/crosshairs.  So if you run it and just move the mouse around slightly while it's working, you may find it ends more quickly than it sometimes seems to.  But it could take unacceptably long with a large number of Blocks, since it goes through an Offset command and an area comparison and an Undoing of the Offset for every Block in the current space.  However, a longer time should be acceptable if  it finds the right set of Blocks reliably and if  other, quicker approaches sometimes don't [I'm not suggesting that all of the others on this thread will sometimes get it wrong, since I haven't tried them].

One last consideration -- for Polylines or Splines with certain kinds of convolutions in their shapes, Offsetting even outward can result in more than one new Polyline, such as here, with the sharp-cornered inner of the two larger Polylines as the selected boundary object:

If a Block's insertion point were on that small skinny wedge shape, Offsetting through that would give this result.  Then if that wedge, and not the bigger outside one, turned out to be the last  object in the drawing, then its area would be compared to that of the original Polyline, and it's obviously smaller, so the routine would think the Block was inside  the original.  That's one circumstance I can think of in which it could give incorrect results, if you would ever have boundaries with that kind of convolution.

[ActivistInvestor · Accepted solution]

---

@Kent1Cooper wrote:

---

@Anonymous wrote:

.... I tested your routine, and I guess this is not complete ( Just a partial routine to register the location of blocks in model space?) I can see it is making a temp. offset boundary, but it disappears after. But it is not returning any Block counts. and more over it is taking too much time to end the routine.

....

---

As I said, it's only to identify which Blocks  have their insertion points inside the boundary object.  [And it should work with any  kind of Offsettable object with area as a boundary -- Polyline, Circle, Ellipse, Spline.  It will "function" even with an Arc or unclosed  Polyline/Ellipse/Spline, though results may sometimes be incorrect.]  It doesn't register their locations, but rather puts them into a selection set variable.  You can confirm whether it found the right ones, by [after running it] starting a command such as Move or Copy and typing in:

---

I don't know if I can recommend the offset kludge for containment testing. The command can be unpredictable with certain objects. If one is comfortable with kludges (mooching off AutoCAD commands), then I think BOUNDARY would be a better route. The example below also demonstrates the use of 'trivial rejection', which means that if there is an easy way to determine if a point could not be within a boundary (e.g., it lies outside the boundary's bounding box/extents), then it doesn't need to be tested with BOUNDARY, which has to do much more work.

;; Point containment using the BOUNDARY command kludge
;;
;; This is an example showing how to use the BOUNDARY
;; command to do point containment testing against any
;; closed curve boundary (which could be a polyline,
;; spline, circle, ellipse, etc.), cannot be used with
;; 3D or heavy polylines.
;;
;; One downside is that the BOUNDARY command does not
;; honor CMDECHO or NOMUTT and displays messages with
;; no way to mute them.


;;; Returns a list of the form ((<key> . n)...)
;;; where <key> is a value derived from each element
;;; in the argument list by the selector function,
;;; and n is the number of elements producing the <key>.

(defun count-by (lst selector / p result key)
   (foreach item lst
      (setq key (apply selector (list item)))
      (setq result
         (if (setq p (assoc key result))
            (subst (cons key (1+ (cdr p))) p result)
            (cons (cons key 1) result)
         )
      )
   )
)

;; returns a list containing the min and max 
;; coordinates of an entity's bounding box

(defun get-boundingbox (e / minpt maxpt)
   (vla-GetBoundingBox (vlax-ename->vla-object e) 'minpt 'maxpt)
   (mapcar 'vlax-safearray->list (list minpt maxpt))
)

;; returns non-nil if point is contained in the 
;; bounds whose min and max points are pmin and
;; pmax. Works with 2d or 3d coordinates

(defun bounds-contains (point pmin pmax)
   (and
      (<= (car pmin) (car point) (car pmax))
      (<= (cadr pmin) (cadr point) (cadr pmax))
      (or (not (cddr point))
          (<= (caddr pmin) (caddr point) (caddr pmax))
      )
   )
)

;; Compute the lower-left and upper-right corner points
;; of the smallest bounding box containing the points in 
;; the argument list.

(defun extents (points)
   (list
      (apply 'mapcar (cons 'min points))
      (apply 'mapcar (cons 'max points))
   )
)

;; Takes the ename of a boundary, a list of items, and
;; a selector function. The selector function is called
;; on each element in the list of items, and must return
;; the coordinate that is to be tested for containment
;; within the boundary. The result is a subset of the
;; argument list of items whose derived coordinates are
;; within the boundary. Elements whose derived coordinate
;; lies exactly on the boundary are not included in the
;; result.
               
(defun get-contained-objects (boundary objlist selector / e pmin pmax result point)
   (setvar "cmdecho" 0)
   (mapcar 'set '(pmin pmax) (get-boundingbox boundary))
   (command ".-BOUNDARY" "_A" "_B" "_N" boundary "" "_I" "_N" "_N" "")
   (setq e (entlast))
   (foreach obj objlist
      (setq point (apply selector (list obj)))
      ;; Use extents of boundary to do trivial rejection:
      (if (bounds-contains point pmin pmax)
         (progn
            (command point)
            (if (not (eq e (entlast)))
               (progn
                  (command "_U")
                  (setq result (cons obj result))
               )
            )
         )
      )
   )
   (command "")
   result
)

(defun ss-to-list (ss)
   (mapcar 'cadr 
      (vl-remove-if 
         (function 
            (lambda (i) 
               (or (not (listp i)) 
                   (/= (type (cadr i)) 'ename))))
         (ssnamex ss -1)))
)

(defun select-extents-of (obj filter / ss pmin pmax)
   (mapcar 'set '(pmin pmax) (get-boundingbox obj))
   (command "._ZOOM" "_O" obj "")
   (setq ss (ssget "C" pmin pmax filter))
   (command "._ZOOM" "_P")
   ss
)
   
;; Selects all inserts within the specified boundary, and
;; displays an itemized count of insertions:

(defun C:SELECTCONTAINEDINSERTS ( / ss boundary e ents inside counts)
   (setvar "cmdecho" 0)
   (cond
      (  (not (setq boundary (car (entsel "\nSelect boundary polyline: ")))))
      (  (not (eq (cdr (assoc 0 (entget boundary))) "LWPOLYLINE"))
         (princ "\nInvalid boundary, requires a closed, planar polyline.")
      (  (not (and (vlax-curve-isclosed boundary) (vlax-curve-isplanar boundary)))
         (princ "\nInvalid boundary, requires a closed, planar polyline."))
      )
      (  (not (setq ss (select-extents-of boundary '((0 . "INSERT")))))
         (princ "\nNothing found."))
      (t (setq ents (ss-to-list ss)) 
         (setq inside
            (get-contained-objects boundary ents
               (function
                  (lambda (ent)
                     (cdr (assoc 10 (entget ent)))))))
         (princ "\n==================================================================")
         (princ (strcat "\nFound " (itoa (length inside)) " objects:\n"))
         (mapcar
            (function
               (lambda (item)
                  (princ (strcat "\n  " (car item) ": " (itoa (cdr item))))))
            (count-by inside
               (function 
                  (lambda (e)
                     (vla-get-EffectiveName (vlax-ename->vla-object e))))))
         (princ "\n\n")
         (apply 'command (append '("._PSELECT") inside '("")))
      )
   )
   (princ)
)
         
     
                                  

[john.uhden]

I may be a little late on this, but use the local search for my @Anonymous_inside function.  "Look, ma, no more rays."

[Anonymous]

Hi Kent1Cooper,

I tested briefly, and it is working perfectly for me. Not sure if I am overseeing some thing. If other users can check and verify by using these two promising lisps ( SELECTCONTAINEDINSERTS and BCOUNTIN) on different scenarios we can make sure it is fool proof.

Thank you one 'n all who contributed in supporting and developing this routines. I really appreciate you guys for the help and support. 

Lets wait for a few days to Accept this as Solution assuming some other user will try this out on their projects.

Regards,

VA

[ActivistInvestor]

---

@Kent1Cooper wrote:

---

@Anonymous wrote:

.... I tested your routine, and I guess this is not complete ( Just a partial routine to register the location of blocks in model space?) I can see it is making a temp. offset boundary, but it disappears after. But it is not returning any Block counts. and more over it is taking too much time to end the routine.

....

---

One last consideration -- for Polylines or Splines with certain kinds of convolutions in their shapes, Offsetting even outward can result in more than one new Polyline, such as here, with the sharp-cornered inner of the two larger Polylines as the selected boundary object:.

---

Also note that OFFSET will not create zero-length objects.

E.g., Offseting a circle through its center point, or a rectangular polyline through the midpoint of its diagonal fails.

[Anonymous]

Hi Kent1Cooper,

If I understand it correctly, those two scenarios will not arise in my work flow if I am using this for counting the blocks inside a viewport boundary right? For boundary purpose I will be using either a polyline ( never a zero  length entity) or a combination of arcs, polylines and circle ( for circle, I will convert it into polylines for shape managing purposes of viewports). Unless and until I come up with some crazy Polyline Boundary, I guess I am safe.

Other users please post your experience so that we can accept this as a Solution pretty soon. I will try this out as soon as I get some breathing time.

Thanks again for your help,

Regards,

VA

[Kent1Cooper]

---

@Anonymous wrote:

....  For boundary purpose I will be using either a polyline ( never a zero  length entity) or a combination of arcs, polylines and circle .... Unless and until I come up with some crazy Polyline Boundary, I guess I am safe. ....

---

Perhaps, assuming all boundaries are single  closed objects of some kind [not made up of separate pieces], and except  for the situation that @ActivistInvestor pointed out that I hadn't thought of, namely that if any Block happens to have its insertion base point exactly at the center  of a boundary object, there will be a problem because the Offset will not  create a zero-area new object to compare to the boundary's area.  If there's any risk of that, the Offset approach should be avoided.

[Anonymous]

Hi Kent1Cooper,

Yes now I totally understood the issue/ concern. This will not arise because in my work flow I have to make sure the block's insertion point should be inside the polyline boundary ( not on the boundary) . If there any minimum distance for the offset I have to keep from the polyline boundary while drafting? How does  AutoCAD know  the block is either in or out? any variable setting? Just curious.

Thanks and regards,

VM

[Kent1Cooper]

---

@Anonymous wrote:

.... This will not arise because in my work flow I have to make sure the block's insertion point should be inside the polyline boundary ( not on the boundary) . If there any minimum distance for the offset I have to keep from the polyline boundary while drafting? How does  AutoCAD know  the block is either in or out? any variable setting? Just curious.

....

---

It's not a question of a Block that may be on the boundary, but that may be exactly at the center  [such as a Circle's center point, or the intersection of the diagonals of a Polyline rectangle].  Offsetting using the Through option and giving it that location will cause a failure, because it won't result in an object that can have its area compared to the boundary's, since the result would have to be of zero area.  Come to think of it, in something like a rectangle, unless it's a square, the Block doesn't need to be at the exact center -- it would also fail in a situation like this white rectangle boundary, if a Block's insertion point was anywhere along the red line through the middle -- Offset won't allow a location along that as a Through point.

Apart from that, there shouldn't be any minimum distance to stay away from the boundary, as long as it is a finite minimum, that is, it's not zero [Offset will refuse a point on the boundary as a Through point], but it sounds like that's not an issue.

To explain again, AutoCAD [at least via the code in Post 19] knows whether it's in or out by Offsetting the boundary with the Through option, using the Block's insertion point for the Through point, and then comparing the area of the result with the area of the boundary.  If the result of the Offset is smaller in area than the boundary, then the Block must be inside [except in peculiar circumstances, as already discussed].  That's not  necessarily the ideal way to do it -- it's just the approach taken in the routine I first linked to [though simplified for the particular circumstances].  By all means Search for other approaches [that is, if  other suggestions in this thread don't work right, for some reason, but I expect some of them do].

[DannyNL]

I've been tinkering around with my own routine and found the problem with not counting the trees in the irregular polyline. The ray casting is only reliable if the ray intersects with the polyline and not just touches the polyline (at a vertice) as this was causing the problem.

I've tried several methods to get a reliable result with rays, offsets and boundaries, but all methods have limitation depending on the shape of the polyline that can cause the counting to be off and miss some blocks. 

What I've changed in my routine is that it no longer uses one ray to determine if it is within a boundary but the routine now casts 12 to 24 rays (depending on the direction to the closest point on the polyline) in all directions. If the block is within the polyline all rays should have intersections with the poyline and the number of intersections doesn't really matter. Yes I know, you can still trick the routine with some special shaped polylines that this method also doesn't work 100% but with testing I've found this the more reliable one.

Can it further be improved? Definitely in optimizing the code I guess and probably also in reliability by adding more precision and combining multiple methods, in exchange for sacrificing speed.

Another limitation to this routine is the use of SSGET since the argument point list apparently can not exceed 256 points, which could easily be the case with complex irregular polylines. But considering the example drawing and the intended purpose described in the OP, I think this will be accurate in 99.99% of the cases.

(defun c:Test (/ T_Selection T_Entity T_LowerLeft T_UpperRight T_Precision T_PointList T_Result T_Previous T_Count T_EntityList T_CheckLine T_IntersectPoints T_BoundaryCheck T_BlockName T_BlockList)  
   (if
      (and
         (princ "\nSelect polyline: ")
         (setq T_Selection (ssget ":S+." '((0 . "*POLYLINE"))))
         (setq T_Object (vlax-ename->vla-object (ssname T_Selection 0)))
         (vlax-Curve-isClosed T_Object)
         (vlax-Curve-isPlanar T_Object)
      )
      (progn
         (setq T_Precision 0.01)         
         (setq T_PointList (_CreatePolylinePointList T_Object T_Precision))
         (if
            (and               
               (setq T_PointList (vl-remove-if '(lambda (T_Point)(setq T_Result (equal T_Previous T_Point))(setq T_Previous T_Point) T_Result) T_PointList))
               (setq T_Selection (ssget "_CP" T_PointList '((0 . "INSERT"))))
            )
            (progn
               (acet-ui-progress "Counting" (sslength T_Selection))
               (setq T_Count 0)
               (foreach T_Entity (vl-remove-if '(lambda (T_Item) (listp (cadr T_Item))) (ssnamex T_Selection))
                  (acet-ui-progress (setq T_Count (1+ T_Count)))
                  (setq T_EntityList (entget (setq T_Entity (cadr T_Entity))))                  
                  (if
                     (_PointInside (cdr (assoc 10 T_EntityList)) T_Object)                     
                     (progn
                        (if
                           (not (assoc (setq T_BlockName (cdr (assoc 2 T_EntityList))) T_BlockList))
                           (setq T_BlockList (cons  (list T_BlockName 1) T_BlockList))
                           (setq T_BlockList (subst (list T_BlockName (1+ (cadr (assoc T_BlockName T_BlockList)))) (assoc T_BlockName T_BlockList) T_BlockList))
                        )                        
                     )
                     (ssdel T_Entity T_Selection)                                             
                  )
                  (if T_CheckLine (entdel T_CheckLine))
               )
               ;(sssetfirst nil T_Selection)
               (acet-ui-progress)
               (princ (strcat "\n ** Total number of blocks found: " (itoa (sslength T_Selection)) "\n"))
               (foreach T_Item (vl-sort T_BlockList '(lambda (T_Block1 T_Block2) (< (car T_Block1) (car T_Block2))))
                  (princ (strcat "\n" (car T_Item) ": " (itoa (cadr T_Item))))
               )
               (princ "\n")
            )
         )
      )
   )
   (princ)
)

(defun _CreatePolylinePointList (CCPL_Object CCPL_Precision / CCPL_Position CCPL_EndParam CCPL_AverageSegmentLength CCPL_SegmentStart CCPL_TempPointList CCPL_SubPosition CCPL_NewPoint CCPL_CheckAngles CCPL_PointList)
   (setq CCPL_Position  0.0)
   (setq CCPL_EndParam (vlax-Curve-GetEndParam CCPL_Object))
   (setq CCPL_AverageSegmentLength (/ (vla-get-Length CCPL_Object) CCPL_EndParam))
   (while
      (< CCPL_Position CCPL_EndParam)
      (if
         (and            
            (> (distance (setq CCPL_SegmentStart (vlax-curve-GetPointatParam CCPL_Object CCPL_Position)) (vlax-curve-GetPointatParam CCPL_Object (1+ CCPL_Position))) CCPL_AverageSegmentLength)
            (<= CCPL_EndParam 128)
         )
         (progn
            (setq CCPL_TempPointList nil)
            (setq CCPL_SubPosition CCPL_Position)
            (while
               (<= CCPL_SubPosition (1+ CCPL_Position))
               (if
                  (setq CCPL_NewPoint (vlax-Curve-GetPointAtParam CCPL_Object CCPL_SubPosition))
                  (setq CCPL_TempPointList (append CCPL_TempPointList (list (vlax-Curve-GetPointAtParam CCPL_Object CCPL_SubPosition))))
               )                  
               (setq CCPL_SubPosition (+ CCPL_SubPosition CCPL_Precision))
            )
            (if
               (vl-some '/= (setq CCPL_CheckAngles (mapcar '(lambda (CCPL_Point) (angle (nth 0 CCPL_TempPointList) CCPL_Point)) (cdr CCPL_TempPointList))) (cdr CCPL_CheckAngles))         
               (setq CCPL_PointList (append CCPL_PointList CCPL_TempPointList))
               (setq CCPL_PointList (append CCPL_PointList (list CCPL_SegmentStart)))       
            )
         )
         (setq CCPL_PointList (append CCPL_PointList (list CCPL_SegmentStart)))
      )   
      (setq CCPL_Position (1+ CCPL_Position))
   )
   CCPL_PointList
)

(defun _PointInside (PI_Point PI_PolylineObject / PI_RayAngles PI_ClosestPoint PI_AngleList PI_RefAngle PI_AngleList PI_CheckLine PI_IntersectPoints PI_CheckList)
   (setq PI_RayAngles (_AngleList 12))
   (setq PI_ClosestPoint (vlax-curve-GetClosestPointTo PI_PolylineObject PI_Point))
   (setq PI_AngleList (mapcar '(lambda (PI_Factor) (* pi PI_Factor)) PI_RayAngles))
   (if
      (not (equal (rem (setq PI_RefAngle (angle PI_Point PI_ClosestPoint)) (/ pi 2.0)) 0))
      (setq PI_AngleList (append (mapcar '(lambda (PI_Factor) (+ (* pi PI_Factor) PI_RefAngle )) PI_RayAngles) PI_AngleList))
   )
   (foreach PI_Angle PI_AngleList
      (setq PI_CheckLine (entmakex (list '(0 . "RAY") '(100 . "AcDbEntity") '(100 . "AcDbRay") (cons 10 PI_Point) (cons 11 (mapcar '- (polar PI_Point PI_Angle 5.0) PI_Point)))))
      (if         
         (not (vl-catch-all-error-p (setq PI_IntersectPoints (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object PI_CheckLine) PI_PolylineObject acExtendNone)))))))
         (setq PI_CheckList (cons (length (_GroupByNum PI_IntersectPoints 3)) PI_CheckList))
         (setq PI_CheckList (cons nil PI_CheckList))
      )
      (entdel PI_CheckLine)
   )
   (if
      PI_CheckList
      (not (vl-some 'not PI_CheckList))
   )
)

(defun _AngleList (AL_Integer / AL_Step AL_Factor AL_Return)
   (setq AL_Step (/ 2.0 AL_Integer))
   (setq AL_Factor 0.0)
   (repeat AL_Integer
      (setq AL_Return (append AL_Return (list (+ 0.0 AL_Factor))))
      (setq AL_Factor (+ AL_Factor AL_Step))
   )
   AL_Return
)

; By Lee Mac
(defun _GroupByNum (l n / r)
   (if
      l
      (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n))
   )
)

[cadffm]

I wrote about problem before..
Another problem is the depend of current view of the autocad object selection, i wrote also about this.
If you want to use this function you have to controle the visible area and zoomlevel before starting the test function.



PM: And (ssget "_:S+." for international call of ssget method

[Anonymous]

Hi Kent1Cooper,

Thanks for the detailed explanation on the possible grey areas  and limitations on the routine. For my kind of work flow the routine is working fine from the testing I have done till now.

I do have one question though,

If the drawing ( model space) or the view port is rotated will this have any effect on the results? I have checked the polyline being rotated , but it actually gives same results, but was curious about the viewport rotation and model space rotation. Any thoughts/ advice on this is appreciated.

Thanks and regards,

VA

[Anonymous]

Hi DannyNL,

I just briefly checked the revised routine  and it is counting all blocks as intended. Thanks for the explanation ( I apologize for not understanding all of it) and insight into the limitations and the programming logic so that the future users are well aware of what they should expect. I will keep testing this in the coming days and will provide a more comprehensive feed back.

Thanks for all the efforts,

Regards,

VA

[Anonymous]

Hi CADffm,

Thanks for the feedback on the routines. I personally did not understand any of this, but the Lisp Programmers and CAD gurus might have.

Regards,

VA

[Anonymous]

Hi all,

Just an update on how close we are in finding an acceptable solution for the requested routine ( how to get an accurate  number of blocks inside a polyline).

So far we have 3 very promising Routines ( SELECTCONTAINEDINSERTS - Thanks to Kent1Cooper; BCountIn - thanks to BeeKeeCZ and TEST - Thanks to DannyNL).

SELECTCONTAINEDINSERTS - is getting consistent results for my kind of work flow and I am satisfied with this routine. Other users please review my original request and please carefully follow Kent1Cooper's advice and explanation on the grey areas and limitations before using it.

BCountIn -  is getting consistent results. for my kind of work flow I am satisfied with this routine. Other users please review my original request and please carefully follow BeeKeeCZ's explanation on the limitations of the routine before using it. Both of this can be great programs for mutually checking and verifying each of these lisps.

TEST - I briefly checked this lisp (just now - after I send the previous reply to DannyNL's post) and found the counts are not consistent in all scenarios tested. I have attached a sample drawing just a fact finding check for other users that the routine is not returning consistent results. The routine is not working on the yellow coloured polylines. In the case of 'polyline converted from the spline', the routine is not even recognizing it as a polyline. I find this as a great opportunity for some LISP Program Wizards to improve the routine so that our CAD community can be benefitted.

Guys, I apologize for not been able to understand the prog. logic and other programming jargon fully which were used by these LISp programming friends.

Other users please feel free to test these and provide your valuable feed back so that these routines can be improved upon.

I personally thank you all for your contributions and help on my request.

I will wait for 3 more days for others to test and verify if there are any opportunity for improvement. By Friday, I will do another update and 'Accept as Solution'.

Regards,

VA

[john.uhden]

Here's a late entry.

I believe it works with polylines, splines, and circles.  Plus you get to name the blocks to find with wildcards.

It treats blocks that are ON the boundary as not being inside.

It does have some trouble with very oddly shaped polylines, like with extreme bulges or overlapping segments.

I forgot to include ellipses, but we can do that if needed.  But it is very quick.

(defun C:BlocksInsideBoundary ( / *error* cmdecho @Inside @delta bnames Oname SS i Object P)
  ;; by John Uhden (01-9-18)
  (gc)
  (vl-load-com)
  (or *acad* (setq *acad* (vlax-get-acad-object)))
  (or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
  (defun *error* (error)
    (if (vl-position cmdecho '(0 1))(setvar "cmdecho" cmdecho))
    (vla-endundomark *doc*)
    (cond
      ((not error))
      ((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
      (1 (princ (strcat "\nERROR: " error)))
    )
    (princ)
  )
  (vla-endundomark *doc*)
  (vla-startundomark *doc*)
  (setq cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command
  (sssetfirst) 
  ;;---------------------------------------------------------------------------------------------
  ;;  Function to determine if a point is inside a curve boundary
  (defun @Inside (PIQ Object / Closest Start End Param P
                               a1 a2 Defl @2D @Bulge)
    ;;               "LOOK, MA'... NO RAYS!"
    ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic.
    ;; v2.0 Revised (09-17-03) - See notes below.
    ;; v3.0 Revised (09-20-03) - See notes below.
    ;; Function to determine whether a point is inside the boundary
    ;; of a closed curve.
    ;; It employs the theorem that the sum of the deflections of a
    ;; point inside the curve should equal 360°, and if outside 0°
    ;; (both absolute values).
    ;; The results with Ellipses were fairly rough, and the results
    ;; with a Spline were very rough, thus the fuzz factor of 2.
    ;;
    ;; Arguments:
    ;;   PIQ    - Point to test (2D or 3D point as a list in UCS)
    ;;   Object - Curve to test (Ename or VLA-Object)
    ;;
    ;; Returns:
    ;;   T   (if the PIQ is inside the curve)
    ;;   nil (if either the arguments are invalid,
    ;;       or the PIQ is on or outside the curve)
    ;;
    ;; NOTES:
    ;;   Requires one or another version of the @delta function,
    ;;     such as included here.
    ;;   It will not work well with self-intersecting (overlapping)
    ;;     bulged polyline segments.
    ;;   Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES,
    ;;     SPLINEs, and maybe even more.
    ;;   Thanks already to Doug Broad for finding bugs.
    (setq Sample 0.5) ; this is better for bulged polylines.
    ;;   Sure, you could decrease the sampling from 0.5 to say 0.1,
    ;;     but it will only slow down the process and still not
    ;;     guarantee success with overlapping bulged segments.
    ;;   DO NOT change the sampling value to anything that is
    ;;     greater than 1 or not evenly divisible into 1, as you
    ;;     would not be sampling vertices.
    ;;   (09-17-03) Found that cusps brought back inside the figure
    ;;     yield a total deflection of (* pi 2), so changed evaluation
    ;;     to see if deflection was greater than 4, which is
    ;;     equivalent to a fuzz factor of 2.28 from (* pi 2).
    (vl-load-com)
    (defun @delta (a1 a2)
      (cond
        ((> a1 (+ a2 pi))
          (+ a2 pi pi (- a1))
        )
        ((> a2 (+ a1 pi))
          (- a2 a1 pi pi)
        )
        (1 (- a2 a1))
      )
    )
    ;; Function to convert a 3D point into 2D for the purpose
    ;; of ignoring the Z value.
    ;; Added (09-20-03)
    (defun @2D (p)(list (car p)(cadr p)))
    ;;-----------------------------------------------------
    ;; Function to determine if an angle is with the sector
    ;; defined by two other angles.
    ;; Returns the delta angle from the first angle.
    ;;
    (defun @insect (Ang Ba Ea)
      (if (> Ba Ea)
        (cond
          ((>= Ang Ba))
          ((<= Ang Ea))
          (1 nil)
        )
        (< Ba Ang Ea)
      )
    )
    (defun @Bulge (Param / Bulge V1 V2 Half Delta Chord Radius Center Ba Ea Ang P)
      (and
        (setq Bulge (vl-catch-all-apply 'vla-getbulge (list Object (fix Param))))
        (numberp Bulge)
        (/= Bulge 0)
        (< Param End)
        (setq V1 (vlax-curve-getpointatparam Object (fix Param)))
        (setq V2 (vlax-curve-getpointatparam Object (1+ (fix Param))))
        (setq V1 (trans V1 0 1))
        (setq V2 (trans V2 0 1))
        (setq Half   (if (minusp Bulge) -0.5 0.5)
              Delta  (* 4.0 (atan (abs Bulge)))
              Chord  (distance V1 V2)
              Radius (/ Chord 2 (sin (/ Delta 2)))
              Center (polar V1 (+ (angle V1 V2)(* (- pi Delta) Half)) Radius)
        )
        (if (minusp Bulge)
           (setq Ba (angle Center V2) Ea (angle Center V1))
           (setq Ba (angle Center V1) Ea (angle Center V2))
        )
        (setq Ang (angle Center PIQ))
        (@insect Ang Ba Ea)
        (setq P (polar Center Ang Radius))
      )
      P
    )
    (and
      (cond
        ((not Object)
          (prompt "  No object provided.")
        )
        ((= (type Object) 'VLA-Object))
        ((= (type Object) 'Ename)
          (setq Object (vlax-ename->vla-object Object))
        )
        (1 (prompt "  Improper object type."))
      )
      (or
        (and
          (< 1 (vl-list-length PIQ) 4)
          (vl-every 'numberp PIQ)
        )
        (prompt " Improper point value.")
      )
      (or
        (not
          (vl-catch-all-error-p
            (setq Start
              (vl-catch-all-apply
                'vlax-curve-getStartPoint
                (list Object)
              )
            )
          )
        )
        (prompt "  Object is not a curve.")
      )
      (or
        (equal Start (vlax-curve-getendpoint Object) 1e-10)
        (prompt "  Curve is not closed.")
      )
      (setq P (trans PIQ 1 0)) ; PIQ in WCS
      (setq Closest
        (vlax-curve-getclosestpointto Object P) ; In WCS
      )
      ;; Test to see if PIQ is on object:
      (not (equal (@2D P)(@2D Closest) 1e-10)) ; in WCS
      (setq End (vlax-curve-getEndparam Object))
      (if (= (vla-get-objectname Object) "AcDbSpline")
        (setq Sample (/ End 100))
        (setq Sample 1.0)
      )
      (setq Param Sample Defl 0.0)
      (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS
      (while (<= Param End)
        (setq Param (min Param End))
        (setq P    (vlax-curve-getpointatparam Object Param)
              a2   (angle PIQ (trans P 0 1)) ; in UCS
              Defl (+ Defl (@delta a1 a2))
              a1 a2
        )
       ; (grdraw PIQ P 3)
        (if (setq P (@Bulge Param))
          (progn
            ;(grdraw PIQ (trans (vlax-curve-getpointatparam Object P1) 0 1) 1)
            ;(grdraw PIQ P 1)
            ;(grdraw PIQ (trans (vlax-curve-getpointatparam Object P2) 0 1) 3)
            (setq a2 (angle PIQ P)
                  Defl (+ Defl (@delta a1 a2))
                  a1 a2
            )
          )
        )
        (setq Param (+ Param Sample))
      )
      ;(print Defl) ; Optional display of results
      (> (abs Defl) 4)
    )
  )
  ;;-----------------------------
  ;;  Begin the action:
  (and
    (setq e (car (entsel "\nSelect  boundary object: ")))
    (setq Object (vlax-ename->vla-object e))
    (setq Oname (vlax-get Object 'ObjectName))
    (cond
      ((not (vl-position Oname '("AcDbPolyline" "AcDb2dPolyline" "AcDbSpline" "AcDbCircle")))
        (alert (strcat "Object selected is a(n) " Oname))
      )
      ((and (/= Oname "AcDbCircle")(= (vlax-get Object 'Closed) 0))
        (alert "Object is not closed.")
      )
      ((zerop (vlax-get Object 'Area))
        (alert "Object has an area of zero (0).")
      )
      (1)
    )
    (setq bnames (getstring "\nEnter block names to find, or * for all <*>: "))
    (or (/= bnames "")(setq bnames "*"))
    (setq SS (ssget "X" (list '(0 . "INSERT")(cons 2 bnames)(cons 410 (getvar "ctab")))))
    (repeat (setq i (sslength SS))
      (setq p (cdr (assoc 10 (entget (setq e (ssname SS (setq i (1- i))))))))
      (if (not (@Inside P Object))
        (ssdel e SS)
      )
      1
    )
    (if (and SS (> (sslength SS) 0))
      (progn
        (princ (strcat "\nFound " (itoa (sslength SS)) " blocks within boundary."))
        (sssetfirst nil SS)
      )
      (alert "No blocks found inside boundary")
    )
  )
  (*error* nil)
)
(defun C:BIB ()(C:BlocksInsideBoundary))

[Kent1Cooper]

---

@Anonymous wrote:

.... 

So far we have 3 very promising Routines ( SELECTCONTAINEDINSERTS - Thanks to Kent1Cooper; BCountIn - thanks to BeeKeeCZ and TEST - Thanks to DannyNL).

.... 

---

[Credit for the SELECTCONTAINEDINSERTS routine should go to @ActivistInvestor, not to me.]

[Anonymous]

[Credit for the SELECTCONTAINEDINSERTS routine should go to @ActivistInvestor, not to me.]

Hi ActivistInvestor and rest all,

My bad.... @@ActivistInvestor please accept my apologies.....

All credits for the LISP routine SELECTCONTAINEDINSERTS goes to @ActivistInvestor.

Kent1Cooper, thanks for notifying me about my error.....really appreciate.

Regards,

VA