Counting all block within polyline

[WHM]

Hi Guys,

 

So I've written a few functions to count all the blocks within a selected polyline, it is working but the I feel there is a much better way to handle the list processing. I'm busy looking into mapcar and lambda functions, but I'm struggling to apply it.

 

What do you guys think?

 

Have a look:

;; Test function

(defun c:test (/ ss bb plist) 
  (if (setq ss (ssget "_+.:S:E:L" '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
    (progn
        (setq bb (ssname ss 0))
        (setq plist (_coordlist bb))
        (_boq plist))))

;; Pline to coordinates

(defun _coordlist (ent / plobj coords num pt ptlist)
    (setq
        plobj (vlax-ename->vla-object ent)
        coords (vlax-get plobj 'Coordinates))
    (setq num (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") 2 3))
    (repeat (/ (length coords) num)
        (repeat num 
        (setq pt (append pt (list (car coords)))
              coords (cdr coords)))
        (setq ptlist (cons pt ptlist)
              pt nil))
    (setq ptlist (reverse ptlist)))

;; Generates output by matching two lists up

(defun _boq (plist / blist clist bline dataext)
  (setq blist (_blklist plist))
  (setq clist (_blkcount blist plist))
  (repeat (length blist)
    (setq bline (list (car blist) (car clist)))
    (setq dataext (cons bline dataext))
    (setq blist (cdr blist))
    (setq clist (cdr clist)))
  dataext)

;; Makes a list of block numbers based on block names

(defun _blkcount ( blist plist / clist ss pblist)
  (setq pblist blist)
  (repeat (length blist)
   (if (setq ss (ssget "_WP" plist (list '(0 . "INSERT")(cons 2 (car blist)))))
    (progn
      (setq clist (cons (sslength ss) clist))
      (setq blist (cdr blist)))))
  (setq clist (reverse clist)))

;; Makes a list of block names

(defun _blklist (plist / ss ctr ent lst)
  (setq ss (ssget "_WP" plist '((0 . "INSERT"))))
  (setq ctr 0)
  (repeat (sslength ss)
    (setq ent (ssname ss ctr))
    (setq lst (cons (cdr (assoc 2 (tblsearch "BLOCK" (cdr (assoc 2 (entget ent)))))) lst))
    (setq ctr (1+ ctr)))
  (setq lst (remove-nil (remove_doubles lst))))

;; Remove duplicates and nil values

(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) (cdr lst))))))

(defun remove-nil ( lst ) (vl-remove nil lst))

 

[mhupp]

This is probably what your looking for.

http://ww3.cad.de/foren/ubb/Forum54/HTML/018135.shtml

 

looks to be in German but you can sus out what you need.

 

Edited April 23, 2021 by mhupp

[BIGAL]

I have changed from use vl-coordinates this is shorter.

 

(setq plent (entsel "\nPick rectang"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(princ co-ord)

 

[WHM]

On 4/23/2021 at 11:51 PM, BIGAL said:

I have changed from use vl-coordinates this is shorter.

 

(setq plent (entsel "\nPick rectang"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(princ co-ord)

 

Wow this works perfectly! Why did change from vl-coordinates, is it because this method is shorter?

[mhupp]

Please note the limits of (ssget "WP" pointlist) with polylines that have arcs.

https://www.cadtutor.net/forum/topic/73104-polyline-coordinates/?do=findComment&comment=581425

Edited May 5, 2022 by mhupp

[wkplan]

Hello all,

 

there is another issue with polylines:

- polylines with double vertices and

-self-intersecting/crossing polylines

 

will cause ssget "C/WP" to fail.

 

BTW, you can check if the polyline has arc/bulges.

If so, there are some routines around here that subsitute the args with a series of short line.segments.

The more line-segments, the better the cnverson works.

 

regards

Wolfgang

[ronjonp]

_WP will fail if there are too many points as well.

[Tharwat]

.... And if the selected polyline is off screen along with any of the targeted objects.  

[WHM]

Thanks for all the feedback! 

 

I was trying to use this on a much bigger scale and I hit most of these issues, a rethink and rewrite is in order!