Jonathan Handojo Posted April 1, 2020 Posted April 1, 2020 (edited) 9 minutes ago, Skierz said: Thanks for highlighting the issue @Jonathan Handojo.I didn't realize that I just wanted the polyline borders to be bolder in many cases that's why I thought of increasing the width. Can you suggest any other alternative ? Also, there is one more thing I want to request that the objects on locked layers should not be selected .Can we include such check ? ssget F will only catch selections that are visible on the screen, which is why I added: (vla-ZoomWindow acadobj (progn (vla-GetBoundingBox vx 'minpt 'maxpt) minpt ) maxpt ) to zoom into each selected polyline temporarily, do the selection, and close it with: (vla-ZoomPrevious acadobj) Because it happened so fast, it didn't seem like your screen zoomed at all and stayed as is. Since your polyline is so many times a lot bigger than a very thin "on-screen" thickness, it shouldn't pose a problem for you. For a locked layer, at the very start of the code: (ssget "_:L" '((0 . "INSERT,*POLYLINE"))) Edited April 1, 2020 by Jonathan Handojo 1 Quote
Skierz Posted April 1, 2020 Author Posted April 1, 2020 17 minutes ago, Jonathan Handojo said: If the blocks are not too thin on the polyline (like half the width of the polyline), it should be fine. Because as long as it's hitting the center of the polyline (which is most likely always gonna be true because if your thickness is negligible compared to the size of the block, it doesn't really matter because the picture above had a thickness of 1000 when your actual size is 100), it will catch the block. For a locked layer, at the very start of the code: (ssget "_:L" '((0 . "INSERT,*POLYLINE"))) Ok got it @Jonathan Handojo sir. I have included the locked layer check . Thanks for all your help. Quote
ronjonp Posted April 1, 2020 Posted April 1, 2020 2 hours ago, Jonathan Handojo said: ssget F will only catch selections that are visible on the screen, which is why I added: This is only on older versions of AutoCAD. Try it (setq p1 (getpoint)p2(getpoint)) ;; Pan off screen (ssget "_F" (list p1 p2)) Quote
Skierz Posted April 2, 2020 Author Posted April 2, 2020 (edited) 20 hours ago, Jonathan Handojo said: ssget F will only catch selections that are visible on the screen, which is why I added: @Jonathan Handojo sir I have tested your lisp code on numbers of drawing and later realized that I have missed one important case in my sample drawing. I apologize for that . The check is that each block should be assigned to a single zone only . So there are some cases in which there is overlap of polylines and blocks are lying in the region common to two or more polylines such blocks should also be highlighted probably by bounding box of different color (refer below image for details) So the modified report should be somewhat as below for the attached sample drawing: (underlined is the modified part which report should contain) Total number of blocks in selection: 90 Total number of zones identified: 4 (ZONE A, ZONE B, ZONE C, ZONE D) Number of blocks outside zones: 8 (4 Type C-sense, 3 Type A-sense, 1 Type B-sense) 1 blocks overlapping on boundaries ZONE C, ZONE D (1 Type B-sense) 2 blocks overlapping on boundaries ZONE B, ZONE D (1 Type C-sense, 1 Type A-sense) 3 blocks overlapping on boundaries ZONE A, ZONE B (1 Type B-sense, 1 Type A-sense, 1 Type C-sense)2 blocks lying in region common to Zone C, Zone D (1 Type B-sense, 1 Type C-sense) Number of blocks outside,overlapping and common to zones : 16 NOTE: If there is no blocks lying into common region between the polylines (zones),then the respective part should be omitted in the report. Here is the attached sample dwg. Thanks in advanceZones_Cadtutor_v4.dwg Edited April 2, 2020 by Skierz Quote
Skierz Posted April 2, 2020 Author Posted April 2, 2020 On 3/31/2020 at 3:08 AM, ronjonp said: Here's another .. no fancy reporting: (defun c:foo (/ _s2l pts s) (defun _s2l (s) (if s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))) ) (foreach x (_s2l (setq s (ssget '((0 . "insert,lwpolyline"))))) (if (= "LWPOLYLINE" (cdr (assoc 0 (entget x)))) (progn (setq pts (mapcar 'cdr (vl-remove-if '(lambda (p) (/= 10 (car p))) (entget x)))) (foreach y (_s2l (ssget "_WP" pts '((0 . "insert")))) (ssdel y s)) (ssdel x s) ) ) ) (sssetfirst nil s) (princ) ) @ronjonp sir can you please update the code to take into consideration the blocks which are also lying in the common region between polylines (zones).I forgot to include it in my previous sample dwg. Here is what the desired result required (refer image) and also find the updated sample dwg attached Thanks Zones_Cadtutor_v4.dwg Quote
Jonathan Handojo Posted April 2, 2020 Posted April 2, 2020 (edited) 7 hours ago, Skierz said: I apologize for that . Don't be. In fact, the more I get from CADTutor, the less bored I'll be, because each case is always a new thing to learn from. Like the post I did just a while ago regarding the two lists in order to do this one. (defun c:notinside ( / *error* acadobj activeundo adoc ains alaps bb blk comms dets ent enty i ins j laprect laps maxpt minpt msg msp obname olaps oneb orgblk oth ovps ovunq pl plpt r ss ssnotbl str unqcomms unqpt unqzones vx x y zdet zname znames ) ;; Error handling function (defun *error* ( msg ) (sssetfirst nil nil) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) ;; Start function (if (setq ss (ssget "_:L" '((0 . "INSERT,*POLYLINE")))) (progn (repeat (setq i (sslength ss)) (if (eq (cdr (assoc 0 (entget (setq ent (ssname ss (setq i (1- i))))))) "INSERT") (setq blk (cons ent blk)) (setq pl (cons ent pl)) ) ) (setq orgblk (length blk)) (foreach x pl ;; Get zone name (setq vx (vlax-ename->vla-object x)) (sssetfirst nil (ssadd x)) (while (progn (initget 1 "Name") (setq zname (entsel "\nSelect text specifying zone name for highlighted line or [Name]: ")) (cond ((null zname) (princ "\nNothing selected")) ((eq zname "Name") (setq zname (getstring T "\nSpecify name for highlighted line: ")) (if (vl-position zname znames) (progn (princ (strcat "\nName \"" zname "\" already exist. Please enter a new name")) T) (progn (setq znames (cons zname znames)) nil) ) ) ((not (wcmatch (cdr (assoc 0 (entget (car zname)))) "TEXT,MTEXT")) (princ "\nObject is not a text")) ((setq zname (cdr (assoc 1 (entget (car zname))))) (if (vl-position zname znames) (progn (princ (strcat "\nName \"" zname "\" already exist. Please enter a new name")) T) (progn (setq znames (cons zname znames)) nil) ) ) ) ) ) ;; Get overlaps & Inside (vla-ZoomWindow acadobj (progn (vla-GetBoundingBox vx 'minpt 'maxpt) minpt ) maxpt ) (setq plpt (mapcar 'cdr (vl-remove-if-not '(lambda (y) (eq (car y) 10)) (entget x))) plpt (if (and (eq (cdr (assoc 70 (entget x))) 1) (null (equal (car plpt) (last plpt) 1))) (append plpt (list (car plpt))) plpt) laps (cond ((JH:sslock (ssget "_F" plpt '((0 . "INSERT"))))) ((ssadd))) olaps (cond ((JH:sslock (ssget "_CP" plpt '((0 . "INSERT"))))) ((ssadd))) ins (cond ((JH:sslock (ssget "_WP" plpt '((0 . "INSERT"))))) ((ssadd))) ains (cons (cons ins zname) ains) ) (mapcar '(lambda (x y / bb) (if (setq bb (ssget "_F" (list x y) '((0 . "INSERT")))) (progn (setq bb (JH:sslock bb)) (repeat (setq j (sslength bb)) (if (ssmemb (setq ent (ssname bb (setq j (1- j)))) ss) (setq laprect (cons (apply 'JH:rectcorner (LM:ssboundingbox bb)) laprect)) ) ) ) ) ) (reverse (cdr (reverse plpt))) (cdr plpt) ) (vla-ZoomPrevious acadobj) (if laps (progn (repeat (setq i (sslength laps)) (if (ssmemb (setq ent (ssname laps (setq i (1- i)))) ss) (setq alaps (cons (cons zname ent) alaps)) ) ) ) ) (if olaps (repeat (setq i (sslength olaps)) (setq blk (vl-remove (ssname olaps (setq i (1- i))) blk)) ) ) ) (sssetfirst nil nil) ;; Get Details (mapcar '(lambda (x / enty oth r) (setq oth (mapcar 'car (vl-remove-if '(lambda (y) (eq (cdr y) (cdr x))) ains))) (repeat (setq r (sslength (car x))) (setq enty (ssname (car x) (setq r (1- r)))) (if (vl-some '(lambda (y) (ssmemb enty y)) oth) (setq comms (cons (cons enty (cdr x)) comms)) ) ) ) ains ) (setq unqcomms (mapcar '(lambda (x) (cons (mapcar 'cdr (vl-remove-if-not '(lambda (y) (equal x (car y))) comms)) x)) (LM:Unique (mapcar 'car comms))) unqzones (mapcar '(lambda (x) (cons x (mapcar 'cdr (vl-remove-if-not '(lambda (y) (equal x (car y))) unqcomms)))) (LM:Unique (mapcar 'car unqcomms))) ovps (mapcar '(lambda (x) (strcat "\n" (itoa (length (cdr x))) " blocks residing in multiple zones [" (LM:lst->str (car x) ", ") "]: " (progn (setq ovunq (mapcar '(lambda (y) (vla-get-EffectiveName (vlax-ename->vla-object y))) (cdr x))) (LM:lst->str (mapcar '(lambda (y) (strcat (itoa (cdr y)) " " (car y))) (LM:CountItems ovunq)) ", ") ) ) ) unqzones ) ssnotbl (JH:list-to-selset blk) ) (while alaps (setq oneb (vl-remove-if-not '(lambda (x) (eq (cdr x) (cdar alaps))) alaps) dets (cons (cons (vla-get-EffectiveName (vlax-ename->vla-object (cdar alaps))) (LM:lst->str (vl-sort (mapcar 'car oneb) '(lambda (a b) (< a b))) ", ")) dets) alaps (vl-remove-if '(lambda (x) (eq (cdr x) (cdar alaps))) alaps) ) ) (setq obname (mapcar '(lambda (x) (vla-get-EffectiveName (vlax-ename->vla-object x))) blk) str (mapcar '(lambda (x) (strcat "\n" (itoa (JH:CountSpecific zdet x)) " blocks overlapping on boundaries " x ": " (LM:lst->str (mapcar '(lambda (y) (strcat (itoa (cdr y)) " " (car y))) (LM:CountItems (mapcar 'car (vl-remove-if-not '(lambda (y) (eq x (cdr y))) dets)))) ", ") ) ) (LM:Unique (setq zdet (mapcar 'cdr dets))) ) msg (strcat "\nTotal number of blocks in selection: " (itoa orgblk) "\nTotal number of zones identified: " (itoa (length pl)) " (" (cond ((LM:lst->str (vl-sort znames '(lambda (a b) (< a b))) ", ")) ("")) ")" "\n" "\nNumber of blocks outside zones: " (itoa (length blk)) " (" (cond ((LM:lst->str (mapcar '(lambda (x) (strcat (itoa (cdr x)) " " (car x))) (LM:CountItems obname)) ", ")) ("")) ")" (apply 'strcat str) (if ovps (apply 'strcat ovps) "") "\n" "\n" "\nNumber of blocks outside" (if ovps ", residing in multiple zones," "") " and overlapping: " (itoa (+ (length blk) (length dets) (length (apply 'append (mapcar 'cdr unqzones))) ) ) ) ) (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") '(8 . "NOTINSIDE-Reports") (assoc 62 (tblsearch "LAYER" (getvar "CLAYER"))) (cons 1 msg) (cons 10 (progn (initget 1) (getpoint "\nSpecify insertion point for text: "))) '(40 . 2200) ; <--- Set text height here '(50 . 0) ) ) (foreach x (LM:UniqueFuzz laprect 1) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (62 . 2) ; <--- Set color here. In this case, it's yellow. Depends on color index (43 . 300) ; <--- Set thickness here (8 . "NOTINSIDE-Overlaps") ; <--- Layer of overlapping boundary marks ) (apply 'append (mapcar '(lambda (y) (list (cons 10 y) '(42 . 0) '(91 . 0) ) ) x ) ) ) ) ) (foreach x unqzones (setq unqpt (apply 'JH:rectcorner (LM:ssboundingbox (JH:list-to-selset (cdr x))))) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (62 . 6) ; <--- Color of overlapping rectangles are set to magenta (43 . 300) (8 . "NOTINSIDE-Common Zones") ; <--- Layer of common zones boundary marks ) (apply 'append (mapcar '(lambda (y) (list (cons 10 y) '(42 . 0) '(91 . 0) ) ) unqpt ) ) ) ) ) (sssetfirst nil ssnotbl) (princ msg) ) ) ;; End function (if activeundo nil (vla-EndUndoMark adoc)) (princ) ) (defun JH:uniqueset (lst / fin) ; Returns a unique (union) selection set from a list of selection sets (setq fin (ssadd)) (mapcar '(lambda (x / a ent) (repeat (setq a (sslength x)) (if (null (ssmemb (setq ent (ssname x (setq a (1- a)))) fin)) (setq fin (ssadd ent fin)) ) ) ) lst ) fin ) (defun JH:sslock (ss / i) (if ss (progn (repeat (setq i (sslength ss)) (if (eq (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget (setq ent (ssname ss (setq i (1- i))))))))))) 4) (ssdel ent ss) ) ) ss ) ) ) (defun JH:CountSpecific (lst itm) ; Returns the number of items itm is inside lst. (- (length lst) (length (vl-remove itm lst)) ) ) (defun JH:rectcorner (a b) (list a (list (car b) (cadr a) (last a)) b (list (car a) (cadr b) (last a)) ) ) (defun JH:list-to-selset (lst / final) (setq final (ssadd)) (mapcar '(lambda (x) (setq final (ssadd x final))) lst) final ) ;; List to String - Lee Mac ;; Concatenates each string in a supplied list, separated by a given delimiter ;; lst - [lst] List of strings to concatenate ;; del - [str] Delimiter string to separate each item (defun LM:lst->str ( lst del / str ) (setq str (car lst)) (foreach itm (cdr lst) (setq str (strcat str del itm))) str ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l / x r ) (while l (setq x (car l) l (vl-remove x (cdr l)) r (cons x r) ) ) (reverse r) ) ;; Unique with Fuzz - Lee Mac ;; Returns a list with all elements considered duplicate to ;; a given tolerance removed. (defun LM:UniqueFuzz ( l f / x r ) (while l (setq x (car l) l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l)) r (cons x r) ) ) (reverse r) ) ;; Count Items - Lee Mac ;; Returns a list of dotted pairs detailing the number of ;; occurrences of each item in a supplied list. (defun LM:CountItems ( l / c l r x ) (while l (setq x (car l) c (length l) l (vl-remove x (cdr l)) r (cons (cons x (- c (length l))) r) ) ) (reverse r) ) ;; Selection Set Bounding Box - Lee Mac ;; Returns a list of the lower-left and upper-right WCS coordinates of a ;; rectangular frame bounding all objects in a supplied selection set. ;; sel - [sel] Selection set for which to return bounding box (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp ) (repeat (setq idx (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx))))) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp)))) ) (setq ls1 (cons (vlax-safearray->list llp) ls1) ls2 (cons (vlax-safearray->list urp) ls2) ) ) ) (if (and ls1 ls2) (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2)) ) ) I've also moved: The overlapping boundaries to the "NOTINSIDE-Overlaps" layer; The common boundaries to the "NOTINSIDE-Common Zones" layer, and; The reporting texts to the "NOTINSIDE-Reports" layer; so you can just turn off or freeze the layer whenever you feel like it. I've tested it on a couple complex situations, out of which one of it is below: Thanks for giving me something to do in the quarantine Edited April 2, 2020 by Jonathan Handojo Exclude locked objects Quote
Skierz Posted April 2, 2020 Author Posted April 2, 2020 (edited) 1 hour ago, Jonathan Handojo said: Thanks for giving me something to do in the quarantine Thank you @Jonathan Handojo sir, you are quite friendly in nature . I am happy that I am keeping you engaged during quarantine I would like to bring one issue to your notice regarding common zone part.I don't wanted the entities on locked layer to be included ,So I changed the below part (if (setq ss (ssget '((0 . "INSERT,*POLYLINE")))) to (if (setq ss (ssget "_:L" '((0 . "INSERT,*POLYLINE")))) It is giving expected result for blocks outside and overlaps (i.e ignoring blocks on locked layer even if they meet the above criteria) ,but for common region ,it is considering the blocks even on locked layers which I don't want to be included. Why this is happening? Thanks Edited April 2, 2020 by Skierz Quote
dlanorh Posted April 2, 2020 Posted April 2, 2020 1 hour ago, Skierz said: Why this is happening? Thanks Because there are other selection sets being constructed that are not excluding blocks on locked layers. Quote
Jonathan Handojo Posted April 2, 2020 Posted April 2, 2020 It's as dlanorh says, there were other selection sets being constructed without omitting locked layer objects. I was under the impression that even locked objects are taken into consideration. Hopefully that's the end of all criteria. Code above is updated to suit. Quote
ronjonp Posted April 3, 2020 Posted April 3, 2020 (edited) On 4/2/2020 at 2:54 AM, Skierz said: @ronjonp sir can you please update the code to take into consideration the blocks which are also lying in the common region between polylines (zones).I forgot to include it in my previous sample dwg. Here is what the desired result required (refer image) and also find the updated sample dwg attached Thanks Zones_Cadtutor_v4.dwg 74.72 kB · 2 downloads Give this a try (defun c:foo (/ _h _s2l d e p s z) ;; RJP » 2020-04-03 (defun _s2l (s / r) (and s (setq r (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))) r) (defun _h (e) (cdr (assoc 5 (entget e)))) (foreach x (_s2l (setq s (ssget ":L" '((0 . "insert,lwpolyline"))))) (if (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget x))))) (progn (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) e))) (if (setq z (_s2l (ssget "_WP" p '((0 . "insert"))))) (progn (foreach y z (ssdel y s)) (setq d (cons (mapcar '_h z) d))) ) (ssdel x s) ) ) ) (setq d (vl-sort (apply 'append d) '<)) (while (setq z (cadr d)) (if (= (car d) z) (progn (ssadd (handent (car d)) s) (setq d (cddr d))) (setq d (cdr d)) ) ) (sssetfirst nil s) (princ) ) Edited April 3, 2020 by ronjonp Quote
Jonathan Handojo Posted April 4, 2020 Posted April 4, 2020 7 hours ago, ronjonp said: Give this a try (defun c:foo (/ _h _s2l d e p s z) ;; RJP » 2020-04-03 (defun _s2l (s / r) (and s (setq r (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))) r) (defun _h (e) (cdr (assoc 5 (entget e)))) (foreach x (_s2l (setq s (ssget ":L" '((0 . "insert,lwpolyline"))))) (if (= "LWPOLYLINE" (cdr (assoc 0 (setq e (entget x))))) (progn (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) e))) (if (setq z (_s2l (ssget "_WP" p '((0 . "insert"))))) (progn (foreach y z (ssdel y s)) (setq d (cons (mapcar '_h z) d))) ) (ssdel x s) ) ) ) (setq d (vl-sort (apply 'append d) '<)) (while (setq z (cadr d)) (if (= (car d) z) (progn (ssadd (handent (car d)) s) (setq d (cddr d))) (setq d (cdr d)) ) ) (sssetfirst nil s) (princ) ) A couple of the blocks are touching the white lines at Zone A though. Should they be highlighted as well? (And one on Zone B) Quote
ronjonp Posted April 4, 2020 Posted April 4, 2020 You're correct. I'll have to revise the code. Didn't spend much time on it Quote
Skierz Posted April 8, 2020 Author Posted April 8, 2020 On 4/2/2020 at 9:29 PM, Jonathan Handojo said: It's as dlanorh says, there were other selection sets being constructed without omitting locked layer objects. I was under the impression that even locked objects are taken into consideration. Hopefully that's the end of all criteria. Code above is updated to suit. Much Thanks @Jonathan Handojo Sir Quote
Skierz Posted April 8, 2020 Author Posted April 8, 2020 On 4/4/2020 at 7:42 AM, Jonathan Handojo said: A couple of the blocks are touching the white lines at Zone A though. Should they be highlighted as well? (And one on Zone B) @ronjonp sir,it is not highlighting some of the overlapping block as rightly pointed out by @Jonathan Handojo Quote
Skierz Posted April 13, 2020 Author Posted April 13, 2020 On 4/4/2020 at 9:32 AM, ronjonp said: You're correct. I'll have to revise the code. Didn't spend much time on it @ronjonp sir, did you manage to revise the code? Thanks Quote
ronjonp Posted April 14, 2020 Posted April 14, 2020 (edited) On 4/13/2020 at 2:15 AM, Skierz said: @ronjonp sir, did you manage to revise the code? Thanks @Skierz Sorry .. have not had time to look at this. Don't you already have multiple solutions? Edited April 14, 2020 by ronjonp Quote
Recommended Posts
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.