WHM Posted October 13, 2020 Share Posted October 13, 2020 Good day all,This is my first post to this forum and I need a little help with a lisp that I'm makingThe goal of this lisp is select all the roads in the drawing, then to count every single road crossing.On small scale (0 - 50 roads) it works, but when handling larger projects I get error: bad argument type: lselsetp nil. Which tells me that it's most likely my selection set that isn't working.Could someone please guide me on where I went wrong? (defun c:RC_count ( / sel s1 ctr2 ss ctr ) (if (setq sel (ssget "x" '((0 . "LWPOLYLINE") (8 . "Streets")))) (progn (setq ctr 0) (setq s1 (ssadd)) (repeat (sslength sel) (setq ss (ssget "_F" (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget (ssname sel ctr)) ) ) '((0 . "LWPOLYLINE")(8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F"));checks the crossing lines );ssget );setq ;sssetfirst (setq ctr2 0) (repeat (sslength ss) (ssadd (ssname ss ctr2) s1) (setq ctr2 (1+ ctr2)) ) (setq ctr (1+ ctr)) );repeat );progn );if (print (sslength s1)) (princ) ) Thanks in advance and I apologize that I'm asking for help on my first post. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted October 13, 2020 Share Posted October 13, 2020 Welcome to CADTutor. If that routine works for you and you just need to avoid that error then you can rectify it as follows: (if ;; ADD THIS FUNCTION (setq ss (ssget "_F" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname sel ctr)))) '((0 . "LWPOLYLINE") (8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F" ) ) ;checks the crossing lines ) ;ssget ) ;setq ;sssetfirst (progn ;; AND THIS FUNCTION (setq ctr2 0) (repeat (sslength ss) (ssadd (ssname ss ctr2) s1) (setq ctr2 (1+ ctr2)) ) )) ;; AND THESE TWO BRACKETS Quote Link to comment Share on other sites More sharing options...
WHM Posted October 13, 2020 Author Share Posted October 13, 2020 45 minutes ago, Tharwat said: Welcome to CADTutor. If that routine works for you and you just need to avoid that error then you can rectify it as follows: (if ;; ADD THIS FUNCTION (setq ss (ssget "_F" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname sel ctr)))) '((0 . "LWPOLYLINE") (8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F" ) ) ;checks the crossing lines ) ;ssget ) ;setq ;sssetfirst (progn ;; AND THIS FUNCTION (setq ctr2 0) (repeat (sslength ss) (ssadd (ssname ss ctr2) s1) (setq ctr2 (1+ ctr2)) ) )) ;; AND THESE TWO BRACKETS Wow this works great!! Thank you very much!! Quote Link to comment Share on other sites More sharing options...
WHM Posted October 13, 2020 Author Share Posted October 13, 2020 I just realized that if a line/lwpolyline crosses the road two or more times, it will only count it as a single crossing, is there anyway around this? Here is the full code: (defun c:RC_count ( / sel s1 ctr2 ss ctr ) (if (setq sel (ssget "x" '((0 . "LWPOLYLINE,LINE") (8 . "Streets")))) (progn (setq ctr 0) (setq s1 (ssadd)) (repeat (sslength sel) (if ;; ADD THIS FUNCTION (setq ss (ssget "_F" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname sel ctr)))) '((0 . "LWPOLYLINE,LINE") (8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F" ) ) ;checks the crossing lines ) ;ssget ) ;setq ;sssetfirst (progn ;; AND THIS FUNCTION (setq ctr2 0) (repeat (sslength ss) (ssadd (ssname ss ctr2) s1) (setq ctr2 (1+ ctr2)) ) )) (setq ctr (1+ ctr)) );repeat );progn );if (alert (strcat "There are " (itoa (sslength s1)) " road crossings in the drawing")) (princ) ) Quote Link to comment Share on other sites More sharing options...
Tharwat Posted October 13, 2020 Share Posted October 13, 2020 The codes should work and count the crossing LWpolylines / Lines correctly unless the LWpolylines have arcs / bulges that the target objects crossing that arc's limits or lines on Z coordinates other than zero. If you upload a real drawing where the routine fails then that would help me to take a close look for you. Quote Link to comment Share on other sites More sharing options...
WHM Posted October 13, 2020 Author Share Posted October 13, 2020 Hi Tharwat, I figured out what the problem was, this routine will select a LWpolyline once even if it crosses the road multiple times. To address this issue I used @Lee Mac Intersection functions, I just adjusted the SSget filters. The only problem I hit was when a have a large dataset (1200 roads and 5000 LWpolylines) it took almost 4 hours to process the selection sets. With the initial program, I can filter the LWpolyline selection set based on if it crosses a road. From there the info gets fed to Lee's code, the processing time went from 4 hours down to 11 minutes! Have a look: ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;; Intersections Between Sets - Lee Mac ;; Returns a list of all points of intersection between objects in two selection sets. ;; ss1,ss2 - [sel] Selection sets (defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn ) (repeat (setq id1 (sslength ss1)) (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1))))) (repeat (setq id2 (sslength ss2)) (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2)))) rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn) ) ) ) (apply 'append (reverse rtn)) ) (defun LM:intersets ( s1 / ss1 ss2 ctr) (setq ctr 0) (if (and (setq ss1 (ssget "x" '((0 . "LWPOLYLINE,LINE") (8 . "Streets")))) (setq ss2 s1);(setq ss2 (ssget "x" '((0 . "LWPOLYLINE,LINE") (8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F")))) ) (foreach pnt (LM:intersectionsbetweensets ss1 ss2) (setq ctr (1+ ctr)) ) ) (alert (strcat "There are " (itoa ctr) " road crossings in the drawing")) (princ) ) (defun c:RC_count (/ sel s1 ctr2 ss ctr ) (if (setq sel (ssget "x" '((0 . "LWPOLYLINE,LINE") (8 . "Streets")))) (progn (setq ctr 0) (setq s1 (ssadd)) (repeat (sslength sel) (if ;; ADD THIS FUNCTION (setq ss (ssget "_F" (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname sel ctr)))) '((0 . "LWPOLYLINE,LINE") (8 . "2F Aerial,4F Aerial,12F Aerial,18F Aerial,36F Aerial,48F Aerial,72F Aerial,96F Aerial,144F Aerial,12F,24F,36F,48F,72F,96F,144F" ) ) ;checks the crossing lines ) ;ssget ) ;setq ;sssetfirst (progn ;; AND THIS FUNCTION (setq ctr2 0) (repeat (sslength ss) (ssadd (ssname ss ctr2) s1) (setq ctr2 (1+ ctr2)) ) )) (setq ctr (1+ ctr)) );repeat );progn );if (LM:intersets s1) (princ) ) (vl-load-com) (princ) Quote Link to comment Share on other sites More sharing options...
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.