Community
Changed BlkCounter to BCPL and added code to create a sorted table.
BTW, did not use the supplied .LSP files as it would take me longer the extract the parts that I need than writing new code 
(defun c:BCPL (/ BCPL_Selection BCPL_Entity BCPL_LowerLeft BCPL_UpperRight BCPL_PointList BCPL_Result BCPL_Previous BCPL_Count BCPL_EntityList BCPL_CheckLine BCPL_IntersectPoints BCPL_BoundaryCheck BCPL_BlockName BCPL_BlockList BCPL_TableObject BCPL_SortOrder BCPL_BlockListSorted BCPL_RowCount BCPL_Block)
(if
(and
(princ "\nSelect boundary: ")
(setq BCPL_Selection (ssget ":S+." '((-4 . "<OR")(0 . "*POLYLINE")(0 . "CIRCLE")(0 . "ELLIPSE")(0 . "SPLINE")(-4 . "OR>"))))
(setq BCPL_Object (vlax-ename->vla-object (ssname BCPL_Selection 0)))
(vlax-Curve-isClosed BCPL_Object)
(vlax-Curve-isPlanar BCPL_Object)
(setq BCPL_PointList (_GetBoundingBox BCPL_Object))
(setq BCPL_Selection (ssget "_CP" BCPL_PointList '((0 . "INSERT"))))
)
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(acet-ui-progress "Counting" (sslength BCPL_Selection))
(setq BCPL_Count 0)
(foreach BCPL_Entity (vl-remove-if '(lambda (BCPL_Item) (listp (cadr BCPL_Item))) (ssnamex BCPL_Selection))
(acet-ui-progress (setq BCPL_Count (1+ BCPL_Count)))
(setq BCPL_EntityList (entget (setq BCPL_Entity (cadr BCPL_Entity))))
(if
(_PointInside (cdr (assoc 10 BCPL_EntityList)) BCPL_Object)
(progn
(if
(not (assoc (setq BCPL_BlockID (list (cdr (assoc 2 BCPL_EntityList)) (_ExtractAttributeTagValue (vlax-ename->vla-object BCPL_Entity) "KEY"))) BCPL_BlockList))
(setq BCPL_BlockList (cons (list BCPL_BlockID 1) BCPL_BlockList))
(setq BCPL_BlockList (subst (list BCPL_BlockID (1+ (cadr (assoc BCPL_BlockID BCPL_BlockList)))) (assoc BCPL_BlockID BCPL_BlockList) BCPL_BlockList))
)
)
(ssdel BCPL_Entity BCPL_Selection)
)
(if BCPL_CheckLine (entdel BCPL_CheckLine))
)
(acet-ui-progress)
(princ (strcat "\n ** Total number of blocks found: " (itoa (sslength BCPL_Selection)) "\n"))
(if
(and
BCPL_BlockList
(not (initget 1))
(not (vl-catch-all-error-p (setq BCPL_TableObject (vl-catch-all-apply '_CreateTable (list (vlax-3d-point (getpoint "\nInsertionpoint for table: ")) (+ (length BCPL_BlockList) 2) 4 11.25 60.0)))))
)
(progn
(setq BCPL_SortOrder (list "[A-Z]" "[a-z]" "[a-z][a-z]"))
(foreach BCPL_Pattern BCPL_SortOrder
(setq BCPL_BlockListSorted (append BCPL_BlockListSorted (vl-sort (vl-remove-if-not '(lambda (BCPL_Item)(wcmatch (cadr (car BCPL_Item)) BCPL_Pattern)) BCPL_BlockList) '(lambda (BCPL_Item1 BCPL_Item2) (< (cadr (car BCPL_Item1))(cadr (car BCPL_Item2)))))))
)
(vla-SetColumnWidth BCPL_TableObject 2 100.0)
(vla-SetColumnWidth BCPL_TableObject 3 40.0)
(vla-SetAlignment BCPL_TableObject acDataRow acMiddleCenter)
(vla-SetTextHeight2 BCPL_TableObject 0 0 0 6.0)
(vla-SetText BCPL_TableObject 0 0 "Block Data")
(vla-SetText BCPL_TableObject 1 0 "Block Preview")
(vla-SetText BCPL_TableObject 1 1 "Attribute Value")
(vla-SetText BCPL_TableObject 1 2 "Block Name")
(vla-SetText BCPL_TableObject 1 3 "Count")
(setq BCPL_RowCount 2)
(foreach BCPL_Item BCPL_BlockListSorted
(if
(not (vl-catch-all-error-p (setq BCPL_Block (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (nth 0 (nth 0 BCPL_Item)))))))
(vl-catch-all-apply 'vla-SetBlockTableRecordId (list BCPL_TableObject BCPL_RowCount 0 (vla-get-ObjectId BCPL_Block) :vlax-true))
)
(vla-SetText BCPL_TableObject BCPL_RowCount 1 (cadr (car BCPL_Item)))
(vla-SetCellAlignment BCPL_TableObject BCPL_RowCount 2 acMiddleLeft)
(vla-SetText BCPL_TableObject BCPL_RowCount 2 (car (car BCPL_Item)))
(vla-SetText BCPL_TableObject BCPL_RowCount 3 (itoa (cadr BCPL_Item)))
(setq BCPL_RowCount (1+ BCPL_RowCount))
)
)
)
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
)
(princ)
)
(defun _CreateTable (CT_InsertionPoint CT_Rows CT_Columns CT_RowHeigth CT_ColumnWidth)
(if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)
(vl-catch-all-apply 'vla-addTable (list (vlax-get-property (vla-get-ActiveDocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) CT_InsertionPoint CT_Rows CT_Columns CT_RowHeigth CT_ColumnWidth))
)
(defun _GetBoundingBox (GBB_Object / GBB_LowerLeft GBB_UpperRight)
(if
(vlax-method-applicable-p GBB_Object 'GetBoundingBox)
(progn
(vla-GetBoundingBox GBB_Object 'GBB_LowerLeft 'GBB_UpperRight)
(setq GBB_LowerLeft (vlax-safearray->list GBB_LowerLeft))
(setq GBB_UpperRight (vlax-safearray->list GBB_UpperRight))
(list
GBB_LowerLeft
(list (nth 0 GBB_UpperRight) (nth 1 GBB_LowerLeft) 0.0)
GBB_UpperRight
(list (nth 0 GBB_LowerLeft) (nth 1 GBB_UpperRight) 0.0)
)
)
)
)
(defun _ExtractAttributeTagValue (EATV_BlockObject EATV_Tag / EATV_Return)
(if
(and
(= (type EATV_BlockObject) 'VLA-OBJECT)
(= (vla-get-ObjectName EATV_BlockObject) "AcDbBlockReference")
(= (vla-get-HasAttributes EATV_BlockObject) :vlax-true)
(= (type EATV_Tag) 'STR)
)
(progn
(foreach EATV_Attribute (vlax-safearray->list (vlax-variant-value (vla-GetAttributes EATV_BlockObject)))
(if
(and
(not EATV_Return)
(= (strcase (vla-get-TagString EATV_Attribute)) (strcase EATV_Tag))
)
(setq EATV_Return (vla-get-TextString EATV_Attribute))
)
)
)
)
EATV_Return
)
(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))
)
)
John,
You're absolutely right, that's why I'm no longer using just one ray to determine if a point is inside the boundary. This was the reason one of my earlier version was missing some blocks as the ray from the insertion point intersected with an even number of points, while being on the inside of the boundary. This was caused by exactly the possibility you described.
But the modified routine doesn't just use one ray but multiple, in this case 12 or 24 depending on angle conditions, in all directions. If the point is inside the boundary all rays should have intersections with the boundary and the number of intersections doesn't really matter.
Well, thinking about it......it actually does if all rays intersect an even times with the polyline, because in that case the point is enclosed by a complex polyline but actually outside the boundary. I'll make some new modifications to the routine for the situation below.
@john.uhden wrote:Be careful there, Danny. We've been through his before. I think it was back around 2003, which was probably before Kent's time so it was probably Tony T. jumping in. I had had the theory that if a ray intersects the boundary an odd number of times, then the origin must be inside the boundary. But Tony pointed out that the ray might intersect just once at a tangent point while its origin was outside the boundary. So that's when I came up with the idea of summing all the deflections, ergo "Look ma, no rays!"
@Anonymous reviewing and testing my old code for Aquaman I found that my @bulge function assumes that if the PIQ is within a bulged segment that it would fall within the start and end angles measured from the arc's center. Not necessarily. with an extreme bulge (internal angle > 180°), the PIQ might fall not within the arc's sector, but between the chord and the center point. I don't remember why I thought I needed the @bulge function, but now I am thinking of just sticking to the deflections alone. That is with the exception of checking to see if the PIQ is actually on the boundary.
I'm busy doing something else right now, but I'll let you know.
Is the red point inside the green polygon ?
It's not like this problem hasn't been studied to death. There's plenty of research on different algorithms. For LISP-based solutions in AutoCAD, I'll still put my money on the BOUNDARY kludge, because it uses the same underlying ACIS APIs that are the product of many years of work.
In ObjectARX, this is a one-liner.
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
