Jump to content

Road crossing count


WHM

Recommended Posts

Good day all,

This is my first post to this forum and I need a little help with a lisp that I'm making

The 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.
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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!!

Link to comment
Share on other sites

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

 

RC Problem.PNG

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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)

 

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...