Counting objects, not blocks,
I have a map of houses and I'm needing to count the houses along a route.I have figured out a way to outline the houses in a closed polyline, then select those elements within that polyline, then QSELECT to filter on only the objects in the layer that I need.I would like to make a LISP routine to speed up this process and simplify it.I also need the LISP to place a text block with the number of houses found inside the polyline. More info need a lot more to help how are the houses defined st No maybe ? I propose the following algorithm:
1. Using the command Selpoly select objects crossing polyline
2. QSELECT -> Apply to Current Selectiont->...
(defun C:SELPOLY ( / pl lst ss);;; Selecting objects intersected by polyline;;; Vladimir Azarko (VVA) for dwg.ru;;; http://forum.dwg.ru/showthread.php?t=82243;| ! *******************************************************************;; ! _IsPtInView;; ! *******************************************************************;; ! Checks whether a point in the viewport;; ! Auguments: 'pt'- Point for analysis in World!!!;; ! Return : T or nil if 'pt' in the viewport or not;; ! *******************************************************************|;(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len) (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")SSZ (getvar "SCREENSIZE")X_Pix (car SSZ) Y_Pix (cadr SSZ)X_Len (* (/ X_Pix Y_Pix) Y_Len))(list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len))) (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))))(defun _IsPtInView (pt / Lc Uc)(setq pt (trans pt 0 1))(setq Lc (_get-viewctr-size) Uc (cadr Lc) Lc (car Lc)) (if (and (> (car pt) (car Lc))(< (car pt) (car Uc)) (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)) )T nil));| ! ***************************************************************************;; ! _pt_extents;; ! ***************************************************************************;; ! Function: Returns the bounds of MIN, MAX X, Y, Z points list;; ! Argument: 'vlist' - A list of points;; ! Returns: list of points (LevNizhn PravVerhn);; ! ***************************************************************************|;(defun_pt_extents (vlist / tmp) (setq tmp (apply 'mapcar (cons 'list vlist))) (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun;;! _Zoom2Lst;;! **********************************************************;;! Function: Zoom boundary points list;;! Arguments: 'vlist' - A list of points in the World!!;;! Zoom screen, so that all points were visible;;! Returns: t - was zooming nil - no;;! ********************************************************** (defun _Zoom2Lst (vlist / pts) (setq pts (_pt_extents (mapcar '(lambda(x)(list (car x)(cadr x))) vlist))) (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts)))) (progn (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)T) nil ) ) ;end(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt);;; Single choice object, replacing the function entsel;;; Returns entity name selected entity or nil,specifying point stored in the variable LASTPOINT;;; Parameters:;;; promt - a proposal to select an object (string);;; filter - a filter to select the type of objects' ("LINE" "LWPOLYLINE");;; entlist - a list of entities that do not have to choose (or a list of entity name, or PICKSET);;;;;; Examples:;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") nil);;; (mip: entsel "\ nPlease select objects" nil nil);;; (setq aa nil) (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a))) ));;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (ssget)) (setq key T n 0 newentlist nil) (if (eq (type entlist) 'PICKSET) (progn (while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n))) (setq entlist newentlist) );progn);if (while key (if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7)) (if (or (eq (type ent_point) 'LIST) (not ent_point)) (if ent_point (if (member (setq ent (car ent_point)) entlist) (princ "\nThe primitive has been selected") (if filter (if (not (member (cdr (assoc 0 (entget ent))) filter)) (progn (setq str "\nNot the right choice, choose: ") (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2))) );progn (setq key nil) );if (setq key nil) );if );if (setq key T) );if (setq key nil) );if(setq key nil) );if );while (if (eq (type ent_point) 'LIST) (progn (setvar "LASTPOINT" (cadr ent_point)) ent) ent_point );if);defun(defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) )) (reverse nlist)) (vl-load-com)(and (setq pl (mip:entsel "\nSelect Polyline" '("LWPOLYLINE") nil)) (setq lst (massoc 10 (entget pl))) (or (_Zoom2Lst lst) t) (setq ss nilss (ssget "_F" (mapcar '(lambda(x)(trans x 0 1)) lst))) (sssetfirst nil ss) ) (princ) )(princ "\nType SELPOLY in command line") My apologies for the lack of information. Attached is a sample drawing of my map. Orange is the structures that I wish to count, White are the roads, Green is the city boundaries, and blue is the polyline around the houses that I wish to count.
I can get the number of structures inside the polyline with my method;
QSELECT> "select objects" button> 'wps (to invoke wps transparently)> select polyline> return to QSELECT> filter based on Layer=Buildings. It returns "236 item(s) selected." Which is the number I want, but for this to be adopted by others, I must have it be even simpler. I would like to be able to run a custom command and select the polyline and it paste text containing the number of items that were selected.
Currently the others are manually counting items from aerial maps, if I can make this easy enough, it will speed up the process greatly.
I tried to use the SELPOLY, but it will be difficult in most cases to line through all the houses when most are in a group and can easly be outlined.
Thanks for all the help so far.
wps.lsp
Drawing1.dwg I'm thinking more along the lines of using wps and adding to it, to remove anything not on the "Buildings" layer from the selection. Then count that selection. I undestand
I modify Selpoly to SelWpoly (select _WP) and add filter
(defun SELWPOLY ( filter / pl lst ss);;; Selecting objectsby polyline (window polygon);;; filter - filter list like ssget functions or nil - not;;; example (setq filter (list(cons 0 "LWPOLYLINE")(cons 8 "Buildings")));;; Return - PICKSET;| ! *******************************************************************;; ! _IsPtInView;; ! *******************************************************************;; ! Checks whether a point in the viewport;; ! Auguments: 'pt'- Point for analysis in World!!!;; ! Return : T or nil if 'pt' in the viewport or not;; ! *******************************************************************|;(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len) (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")SSZ (getvar "SCREENSIZE")X_Pix (car SSZ) Y_Pix (cadr SSZ)X_Len (* (/ X_Pix Y_Pix) Y_Len))(list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len))) (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))))(defun _IsPtInView (pt / Lc Uc)(setq pt (trans pt 0 1))(setq Lc (_get-viewctr-size) Uc (cadr Lc) Lc (car Lc)) (if (and (> (car pt) (car Lc))(< (car pt) (car Uc)) (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)) )T nil));| ! ***************************************************************************;; ! _pt_extents;; ! ***************************************************************************;; ! Function: Returns the bounds of MIN, MAX X, Y, Z points list;; ! Argument: 'vlist' - A list of points;; ! Returns: list of points (LevNizhn PravVerhn);; ! ***************************************************************************|;(defun_pt_extents (vlist / tmp) (setq tmp (apply 'mapcar (cons 'list vlist))) (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun;;! _Zoom2Lst;;! **********************************************************;;! Function: Zoom boundary points list;;! Arguments: 'vlist' - A list of points in the World!!;;! Zoom screen, so that all points were visible;;! Returns: t - was zooming nil - no;;! ********************************************************** (defun _Zoom2Lst (vlist / pts) (setq pts (_pt_extents (mapcar '(lambda(x)(list (car x)(cadr x))) vlist))) (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts)))) (progn (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)T) nil ) ) ;end(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt);;; Single choice object, replacing the function entsel;;; Returns entity name selected entity or nil,specifying point stored in the variable LASTPOINT;;; Parameters:;;; promt - a proposal to select an object (string);;; filter - a filter to select the type of objects' ("LINE" "LWPOLYLINE");;; entlist - a list of entities that do not have to choose (or a list of entity name, or PICKSET);;;;;; Examples:;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") nil);;; (mip: entsel "\ nPlease select objects" nil nil);;; (setq aa nil) (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a))) ));;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (ssget)) (setq key T n 0 newentlist nil) (if (eq (type entlist) 'PICKSET) (progn (while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n))) (setq entlist newentlist) );progn);if (while key (if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7)) (if (or (eq (type ent_point) 'LIST) (not ent_point)) (if ent_point (if (member (setq ent (car ent_point)) entlist) (princ "\nThe primitive has been selected") (if filter (if (not (member (cdr (assoc 0 (entget ent))) filter)) (progn (setq str "\nNot the right choice, choose: ") (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2))) );progn (setq key nil) );if (setq key nil) );if );if (setq key T) );if (setq key nil) );if(setq key nil) );if );while (if (eq (type ent_point) 'LIST) (progn (setvar "LASTPOINT" (cadr ent_point)) ent) ent_point );if);defun(defun massoc (key alist / x nlist) (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist)) )) (reverse nlist)) (vl-load-com)(and (setq pl (mip:entsel "\nSelect Polyline" '("LWPOLYLINE") nil)) (setq lst (massoc 10 (entget pl))) (or (_Zoom2Lst lst) t) (setq ss nilss (if filter (ssget "_WP" (mapcar '(lambda(x)(trans x 0 1)) lst) filter ) (ssget "_WP" (mapcar '(lambda(x)(trans x 0 1)) lst) ) )) (sssetfirst nil ss) ) ss )(defun C:SELWPOLY()(SELWPOLY nil))(princ "\nType SELWPOLY in command line")
How to create Custom command (use function selwpoly and filter list)
(defun C:CUSTOM1 ( / ss tstyle) ;;; (setq *TEXTSIZE* (getvar "TEXTSIZE")) ;_Text height (setq *TEXTSIZE* 0.0005) ;_Text height I am not a lsp guy, so please pardon my ignorance...but...
Are you complicating the selection process?If the buildings are already outlined with a closed polyline and on a unique layer...why not use the command 'SSX' and filter using the layer?This will result in the number of closed polylines on that layer.
Just a thought.Otherwise, cool coding.I would like to learn it, but there is only so much time in any given day. Worked like a charm! Thanks, VVA! The SELWPOLY works wonderfully most of the time, but every now and then I have a problem where I will select a closed polyline (that has at least one object in it) and it will show
Select PolylinenilCommand:
in the command line.I have attached part of a drawing where this is occuring. I can use SELWPOLY on the white county, but the red one will not work. I hatched the red one to make sure that the line in the middle was actually inside the polyline and it is. Thanks in advance.
Polyline - SELWPOLY.dwg red polyline is too complicated for the function ssget. When using the "Window Polygon" on an imaginary polygon restrictions apply:
- A polygon should be convex or concave
- There should be no overlapping vertices.
页:
[1]
2