Lisp creation: Object counts based on enclosed Polyline

[jeguizaASRZM]

Hello,

I have found many great lisp routines that have been created from people of the AutoCAD forum. I was hoping someone can guide me to changing one of the lisps to complete a very specific task.

I am not familiar with creating or modifying lisps so I hope someone can help. I have tried to modify it myself with trial and error. All I have been able to do is modify the scale of the table. So now I'm really stuck.

I have found two lisp routines, the first one is BCPL. However the BCPL does not recognize my points as blocks. I have created blocks that the lisp routine does recognize but I wish It just recognized objects names, specific layers, or colors.

It Is Still A Great Lisp! I like how it generates a table after you select the enclosed Polyline and gives you a quantity.

The second one is SELECTCONTAINEDINSERTS.

The second lisp SELECTCONTAINEDINSERTS does almost the same. It counts the blocks or objects in a enclosed Polyline, but gives you the list and counts on the command menu. I really like how it I create a Polyline, select it, and gives me a count.

What I'm trying to do is this-

I have Inserted Points using the MAPIMPORT from a .CSV File. So now the reference Points come out as "Map_Survey_Points" objects.

I would like the new lisp to count the object "Map_Survey_Points" inside a specific Polyline. I would Like to create different Polylines with different colors and have the table reflect it in the table as background fill (Demonstration shown in the DWG) as part of the lisp command. The table would depend on the Polyline created.

I would really like to Use SELECTCONTAINEDINSERTS as the base for the new lisp (if someone can help). (I'm hoping this lisp would be easier to modify)

The second request would be for the lisp routine to have that same table update the counts if the selected polyline is changed. So as I change the Polyline it would't just keep making a new table but rather have a set table (after inserting the table at the initial command) were the Count Column of the block can change based on the Polyline. (The Table would depend on the initial Polyline selected) So for example if I move a vertex or stretch the Polyline and use the command "REGEN" or "REGENALL" the table Count Column would update with the new count of a specific object( in my case Map_Survey_Points) inside the Polyline

My biggest Idea for modification is for the routines is to have an option to only pick specific blocks or objects based on Block Name or Layer, using a Polyline as a boundary, and generate a table with the quantity. And for the table to update the count if the polyline is modified

Would This be possible?

Am I Asking the impossible?

Where can I Go?

I know this is a huge request, but thank you for anyone that is willing to help.

Any Help, Guidance, Ideas are very Appreciated

[Sea-Haven]

For multi object selections but in one program use a pick object 1st then the ssget WP knows what it is looking for. You may want a use layer yes/no color etc as extra options. So block with name= added to filter list. A dcl with radio buttons on off for common stuff. Like layer color name height style 

The table needs custom code to be written.

[Sea-Haven]

Have a look at this

(defun c:ahminitab (/ colwidth numcolumns numrows objtable rowheight sp vgms lay2 ss obj obj2)
(vl-load-com)

 
; convert now to xyz
(defun co-ords2xy ()
(setq I 0)
(setq co-ordsxy '())
(repeat (/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

; obj has color if 256 is bylayer no check for rgb

(while (setq obj (vlax-ename->vla-object (car (entsel "Pick Pline"))))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn

(setq col (vla-get-color obj))
(if (= col 256)
(progn
(setq lay (vla-get-layer obj))
(setq xxx (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lays xxx
(if (= lay (vla-get-name lays))
(setq col (vla-get-color lays))
)
)
)
)
(setq co-ords  (vlax-safearray->list (vlax-variant-value   (vlax-get-property  obj  "Coordinates"))))
(co-ords2xy)

(setq sp (vlax-3d-point (getpoint "pick top left for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 3)
(setq numcolumns 1)
(setq rowheight 125)
(setq colwidth 900)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Block Data")

(command "_zoom" "e")


(setq acCol (vla-get-truecolor objtable))
(vla-put-colormethod acCol acColorMethodByACI)
(vla-put-colorindex acCol col)
(vla-setcellbackgroundcolornone objtable 1 0 :vlax-false)
(vla-setcellbackgroundcolor objtable 1 0 accol)
(vlax-release-object acCol)

(setq obj2 (vlax-ename->vla-object (car (entsel "Pick object to count"))))
(setq lay2 (vla-get-layer obj2))

(setq objname (vla-get-objectname obj2))
(if (= objname "AcDbBlockReference")
(progn
(setq ssname (vla-get-name obj2))
(setq ss (ssget "wp" co-ordsxy (list (cons 0 "Insert")(cons 8 lay2)(cons 2 ssname))))
)
)


(vla-settext objtable 2 0 (rtos (sslength ss) 2 0))
)
)
)

(princ)
)

(alert "To run again type \n \n ahminitab \n \n press Enter to exit")

(c:ahminitab)

[jeguizaASRZM]

@Sea-Haven Thank you for your help!

The Table Looks great!

I had a question, about the lisp. The method of picking the objects is done by selecting the object. Is there anyways the program can count all the objects by name for example "Map_Survey_Points". I am very new to lisp routines (so I really appreciate the help).

I am trying to understand how the lisps are set up and what each command does, and found this section of BCPL that (at least I think this is what it does) counts all objects inside the Polyline? would this help in modifying the ahminitab lisp. That way when we "Pick The Polyline" we select the object, then it counts all other objects with the same name in that Polyline. I was able to use the ahminitab to pick a Polyline and generate a great table, based on the Polyline color and the initial picked object. But the selection proccess only recognized the initial pick, not all objects enclosed in the Polyline. (Again, as a new user for AutoCAD and Lisp routines I really appreciate all the help) 

(defun _PointInside (PI_Point PI_PolylineObject PI_OnEdgeTrue / PI_ClosestPoint PI_Distance PI_RayAngles PI_AngleList PI_RefAngle PI_AngleList PI_CheckLine PI_IntersectPoints PI_CheckList PI_Return)
(setq PI_ClosestPoint (vlax-curve-GetClosestPointTo PI_PolylineObject PI_Point))
(setq PI_Distance (distance PI_Point PI_ClosestPoint))
(if
(not (equal PI_Distance 0.0))
(progn
(setq PI_RayAngles (_AngleList 12))
(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)
)
)
)
(cond
(
(and
(equal PI_Distance 0.0)
PI_OnEdgeTrue
)
T
)
(
(and
(not (vl-some 'not PI_CheckList))
(vl-some '(lambda (PI_Value) (= (rem PI_Value 2) 1)) PI_CheckList)
)
T
)
(
T
nil
)
)
)

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

Would This help us in anyway?

[Sea-Haven]

I wrote it as a more universal program, if you want just the block points you can change the ssget filter. removed the pick object.

(defun c:ahminitab (/ colwidth numcolumns numrows objtable rowheight sp vgms lay2)
(vl-load-com)

 
; convert now to xyz
(defun co-ords2xy ()
(setq I 0)
(setq co-ordsxy '())
(repeat (/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

; obj has color if 256 is bylayer no check for rgb

(while (setq obj (vlax-ename->vla-object (car (entsel "Pick Pline"))))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn

(setq col (vla-get-color obj))
(if (= col 256)
(progn
(setq lay (vla-get-layer obj))
(setq xxx (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lays xxx
(if (= lay (vla-get-name lays))
(setq col (vla-get-color lays))
)
)
)
)
(setq co-ords  (vlax-safearray->list (vlax-variant-value   (vlax-get-property  obj  "Coordinates"))))
(co-ords2xy)

(setq sp (vlax-3d-point (getpoint "pick top left for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 3)
(setq numcolumns 1)
(setq rowheight 125)
(setq colwidth 900)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "Block Data")

(command "_zoom" "e")


(setq acCol (vla-get-truecolor objtable))
(vla-put-colormethod acCol acColorMethodByACI)
(vla-put-colorindex acCol col)
(vla-setcellbackgroundcolornone objtable 1 0 :vlax-false)
(vla-setcellbackgroundcolor objtable 1 0 accol)
(vlax-release-object acCol)

(setq ss (ssget "wp" co-ordsxy (list (cons 0 "Insert")(cons 2 "Map_Survey_Points"))))

(vla-settext objtable 2 0 (rtos (sslength ss) 2 0))
)
)
)

(princ)
)

(alert "To run again type \n \n ahminitab \n \n press Enter to exit")

(c:ahminitab)

[jeguizaASRZM]

Thank you for your help,

would you be able to explain some of the lisp routine. I have very little understanding but am committed to learning lisps(I am very new to this so I've made some comments with questions and ideas of what each line does). I was hoping you can shed some light on what I don't understand. I've made comments and used ";;" so nothing in the routines is changed. I wish I could add the selection method to how "SelectContainInsert" uses and use it with your lisp. But I don't know how to add this. So instead of creating a list with counts of objects in the enclosed polyline it creates the table you have created in your lips

START OF LISPS SECTION I WANT TO INCLUDE IN NEW LISPS"

;; 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)
(command "._ZOOM" "_O" obj "")
(setq ss (ssget "C" (getvar "EXTMIN") (getvar "EXTMAX") filter))
(command "._ZOOM" "_P")
ss
)

" END OF LISPS

(defun c:ahminitab (/ colwidth numcolumns numrows objtable rowheight sp vgms lay2 ss obj obj2)
(vl-load-com)

; convert now to xyz
(defun co-ords2xy ()
(setq I 0)
(setq co-ordsxy '())
(repeat (/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
)

;;what does the above section do?

; obj has color if 256 is bylayer no check for rgb

(while (setq obj (vlax-ename->vla-object (car (entsel "Pick Pline"))))
(if (= (vla-get-objectname obj) "AcDbPolyline")
(progn

;;allows pick object selection for pline

(setq col (vla-get-color obj))
(if (= col 256)
(progn
(setq lay (vla-get-layer obj))
(setq xxx (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lays xxx
(if (= lay (vla-get-name lays))
(setq col (vla-get-color lays))
)
)
)
)

;;allows for pline color to be identified?

(setq co-ords (vlax-safearray->list (vlax-variant-value (vlax-get-property obj "Coordinates"))))
(co-ords2xy)

(setq sp (vlax-3d-point (getpoint "pick top left for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 3)
(setq numcolumns 1)
(setq rowheight 125)
(setq colwidth 900)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "A LEG")

;;creates table width?

(command "_zoom" "e")

;;zoom extends?

(setq acCol (vla-get-truecolor objtable))
(vla-put-colormethod acCol acColorMethodByACI)
(vla-put-colorindex acCol col)
(vla-setcellbackgroundcolornone objtable 1 0 :vlax-false)
(vla-setcellbackgroundcolor objtable 1 0 accol)
(vlax-release-object acCol)

;;sets table variables?

(setq obj2 (vlax-ename->vla-object (car (entsel "Pick object to count"))))
(setq lay2 (vla-get-layer obj2))

(setq objname (vla-get-objectname obj2))
(if (= objname "AcDbBlockReference")
(progn
(setq ssname (vla-get-name obj2))
(setq ss (ssget "wp" co-ordsxy (list (cons 0 "Insert")(cons 8 lay2)(cons 2 ssname))))
)
)

;;what does the above section do?
(vla-settext objtable 2 0 (rtos (sslength ss) 2 0))
)
)
)

(princ)
)

(alert "To run again type \n \n ahminitab \n \n press Enter to exit")

(c:ahminitab)

COMMENTS FOR "AHMINITAB" ARE IN BOLD FONT

Again, thank you so much for responding,

I am so great full for your time,

[Sea-Haven]

The ssget, get a selection of entities uses the WP option "within polygon" which uses a list of the pline vertices. in your case this could be the boundary you have made use (entlast) to save the boundary as a variable.

The  convert now to xyz  (defun co-ords2xy () is because I have converted the pline into a VLisp variable and use the get co-ordinates method to do just that get all the vetice co-ordinates. Yhey are returned as X Y X Y X Y the routine converts to ((x y)(x y)… with 3dpolylines you get X Y Z X Y Z X Y Z again convert to ((X Y Z)(X Y Z) but in 3's per list.

If I rewrite the select pline to use entget (assoc 1 which will give the object name = LWPOLYLINE so make sure a pline is chosen.

Select entity: ((-1 . <Entity name: 3add2910>) (0 . "LWPOLYLINE") 

I could then use this method to get the list of pline vertices.

(if plent (setq co-ordsxy (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))

If you post a dwg of what you want would make more sense.

[jeguizaASRZM]

Thank you for the response!

I'm getting a better understanding of the lips.

And of course I can provide a dwg!

It will be an attachment, along with SELECTCONTAININSERT LISP.

This lisp counts the objects inside the Polyline, but only displays the results in the command menu of AutoCAD.

It would be great to just add the method of counting the specific object (MAP_SURVEY_POINTS) from the SELECTCONTAININSERT LISP to your lisps.

Thanks For The Response!

[Sea-Haven]

The second post is hard coded for your blocks to be selected automatically.

[jeguizaASRZM]

It looks like it doesn't work for me. Would you be able to share a screen cast with how you run the routine? I am able to manually select some points after choosing the Polyline but the routine only uses the initial picked object(only one time) to count the object. It doesn't counts all "MAP_SURVEY_POINTS"  inside the enclosed Polyline.

Maybe I'm doing something wrong?

Thank you for your time once again!

[Sea-Haven · Accepted solution]

Ok found 1 problem I had the block name as a plural points instead of point. This was copied from the post here.

The issue with the count being wrong is that to find the objects "within Polygon" they must be entirely within if you look at image it appears there are 5 blocks, but 2 of them touch the edge. If I add touch edge then it will be complicated if plines are next to each other just need a little bit more care, could use qselect change scale make small do table then rescale if making plines becomes a problem.

The file attached has the lisp corrected for (cons 2 "Map_Survey_Point")

Regards

[jeguizaASRZM]

Awesome! This is great! Thank you for the modification the lips routine.

I have one idea, would it be possible for the lips routine to use point of insertion based on x and y to determined how many objects are inside the Polyline?

Changing the scale worked great! it gave me more accurate counts, but would switching how it counts the objects turn over to a more exact count?

Thank You For Your Time,

[jeguizaASRZM]

I also was wondering how i can insert a text justification for the 3rd row, 

I was thinking I can use 

(setq SetAlignment objtable 2 0 MiddleCenter MC) 

but I cannot figure out where I can insert this to your lips. Any ideas of what I'm doing wrong? Do I have to define the variable somewhere else?

Thank you for your help and dedication to passing on some understanding for lips routines!

JE

[Sea-Haven · Accepted solution]

Change code to this

(vla-settext objtable 2 0 (rtos (sslength ss) 2 0))
(vla-SetAlignment objtable acDataRow acMiddleCenter)

[jeguizaASRZM]

Thank You so much for all your help!

Thank You for your time and patience!

All Credit will be added to you, @Sea-Haven 

Hope one day I can learn to program and help other just like you helped me! 

Thank You!

[Sea-Haven]

If I find time will add check insert point. This would though add a time factor as it would look at all blocks inside and out. I can just add change scale then back if you want much easier.

[jeguizaASRZM]

Yes! That worked Perfectly, I was able to get better counts by changing the Factor

Thank You!

I am Currently trying to make the counts be based on the picked polyline. So for example if I change the polyline and make the polyline cover more points. I would like the table to reflect the new count inside the initial created table. Like a refresh count based on the same polyline. Would It be trouble if I send you (may be wrong) what I think a new code line can be so that the polyline can be changed but the table remain the same?

Thank You so Much!

[Sea-Haven]

Auto updating a count may not be possible if using fields you can do stuff like length and area these will update.

The time to erase and redo may out way an auto update could add a update into the code. Pick table pick pline.

I think doing the autoscale 1st is worthwhile say reduce 1/10.

Regards

[jeguizaASRZM]

Here's something I was playing with.

I have used Data extraction to count the objects and it gives me a count for all objects in the .dwg. When I delete some of the objects it gives me an option to "Update Data Extraction".

My question would be, how does the count update with the data extraction, does inside the table cell have a a "Insert Field" variable? 

I was digging to see if maybe the "Insert Field Variable" had something that counts the units and maybe we can use that variable as an addition to the lips, but only found things like you said, Area, length, color, scale, ext. Any ideas on this?

[Sea-Haven]

it may be possible to save the pline entity name into the table say in the second row, a update all tables would find the entity names and redo the count. Its a fair bit of work, compared to how often would you change the shape or number of points and just do again,