count block

Anonymous — Fri, 02 Jun 2017 00:22:28 GMT

I have got the count block lsp thank you everyone. I want it selecting only block name "arc-cp"

"arc-cp" is block name. plz some help

;; helper functions:

;;get indexes and valiues of polyline bulges

(defun get-bulge-list (pline_obj point_list / index bulge_list)
(setq index 0)
(while (< index (length point_list))
    (setq bulg      (vla-getbulge pline index)
   bulge_list (cons (list index bulg) bulge_list)
   index      (1+ index)
    )
)
(vl-remove-if
    (function (lambda (x) (zerop (cadr x))))
    (reverse bulge_list)
)
)

;; groups sublists by number

(defun group-by-num (lst num / ls ret)
(if (= (rem (length lst) num) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
(repeat num
   (setq ls
      (cons (car lst) ls)
  lst (cdr lst)
   )
)
(setq ret (append ret (list (reverse ls)))
       ls nil
)
      )
    )
)
ret
)

;; divide list by number

(defun divplus (len segm / num lst)
(setq num (fix (/ len segm)))
(setq cnt 0)
(while (<= cnt num)
    (setq tmp (* cnt segm))
    (setq lst (append lst (list tmp)))
    (setq cnt (1+ cnt))
)
(setq delta (- len (last lst)))
(if (/= delta 0.)
    (setq lst (append lst (list (+ (last lst) delta))))
    lst
)
)

;; divide parameter by number

(defun divparam (param num / cnt diff div_list div_lst end tmp)
(setq end (1+ param)
diff (/ param num 1.0)
cnt 1
)
(while (< tmp (- end diff))
    (setq tmp   (+ param (* cnt diff))
   div_lst (cons tmp div_lst)
   cnt   (1+ cnt)
    )
)
(reverse div_lst)
)

;; get list of point defined by list of parameters

(defun pnt-by-param (obj param_list /)
(mapcar (function (lambda (x)
        (vlax-curve-getpointatparam obj x)
      )
   )
   param_list
)
)

;; create safearray of points

(defun safe-points (lst / pt_list points)
(setq pt_list (apply 'append lst))
(setq points (vlax-safearray-fill
   (vlax-make-safearray
     vlax-vbdouble
     (cons 0 (1- (length pt_list)))
   )
   pt_list
        )
)
)

;; error handler

(defun div-error (msg)
(if
    (vl-position
      msg
      '("console break"
"Function cancelled"
"quit / exit abort"
       )
    )
     (princ "Error!")
     (princ msg)
)
(while (> (getvar "cmdactive") 0) (command))
(command "._undo" "_end")
(command "._u")
(setq *error* olderror)
(princ)
)

;;        ;;
(vl-load-com);load ActiveX
;;        ;;
(prompt "\n *** Type WP to execute *** \n")
;;        ;;

;;   MAIN PROGRAM    ;;
(defun C:wp (/        *error* acsp    adoc      appd
      bulge_list   coor    coors     div-error
      new_pline olderror param_list      pline
      quant     ss tmp    util      wp-filt
     )

(or adoc
      (setq adoc
      (vla-get-activedocument
        (vlax-get-acad-object)
      )
      )
)
(or appd (setq appd (vla-get-application adoc)));no needs in this prgm
(or acsp
      (setq acsp
      (vla-get-block
        (vla-get-activelayout adoc)
      )
      )
)
(or util (setq util (vla-get-utility adoc)))
(command "._undo" "_end")
(command "._undo" "_mark")
(setq olderror *error*)
(setq *error* div-error)

(setq pline (vlax-ename->vla-object (car (entsel "Select polyline"))))
(setq coors (vlax-get pline 'Coordinates)
coors (cond ((= (rem (length coor) 2) 0)
       (group-by-num coors 2)
      )
      ((= (rem (length coor) 3) 0)
       (group-by-num coors 3)
      )
      (T nil)
       )
coors (mapcar (function (lambda (x) (trans x 0 1))) coors)
)
(setq bulge_list (get-bulge-list pline coors))
(setq param_list nil)
(foreach p bulge_list
    (setq tmp      (divparam (caar bulge_list) 36);change number by suit
   param_list (append tmp param_list)
   bulge_list (cdr bulge_list)
    )
)

(setq wp-filt
(vl-sort (append coors (pnt-by-param pline param_list))
    (function (lambda (a1 a2)
         (< (vlax-curve-getdistatpoint pline a1)
     (vlax-curve-getdistatpoint pline a2)
         )
       )
    )
)
)
(setq new_pline (vla-addpolyline acsp (safe-points wp-filt)))
(vlax-put-property new_pline 'Closed :vlax-true)
(setq coors (vlax-get pline 'Coordinates)
coors (cond ((= (rem (length coor) 2) 0)
       (group-by-num coors 2)
      )
      ((= (rem (length coor) 3) 0)
       (group-by-num coors 3)
      )
      (T nil)
       )
)
;;;(setq ss (ssget "_WP" coors));for debug only
(setq ss (ssget "_WP" coors (list (cons 0 "INSERT"))))

;; < ** PUT YOUR FUNCTION HERE ** >

;; i.e. quantity of objects within polyline

;;TesT:
(setq quant (vla-get-count
  (vla-get-activeselectionset adoc)
       )
)        ;end of TesT
(alert
    (strcat "There are: " (itoa quant) "\n blocks selected")
)
(vla-delete new_pline)
(mapcar (function (lambda (x)
        (if (not (vlax-object-released-p x))
   (vlax-release-object x)
        )
      )
   )
   (list pline new_pline)
)

(setq *error* olderror
div-error nil
)
(command "._undo" "_end")
(princ)
)
;;Test (C:wp)
;;(princ)

Re: count block

Ranjit_Singh — Fri, 02 Jun 2017 02:12:53 GMT

I am not at my computer so cannot test. But try changing this

(setq ss (ssget "_WP" coors (list (cons 0 "INSERT"))))

(setq ss (ssget "_WP" coors (list (cons 0 "INSERT") (cons 2 "arc-cp"))))

Re: count block

Anonymous — Fri, 02 Jun 2017 04:26:02 GMT

it's good working thank you...

topic count block in Visual LISP, AutoLISP and General Customization Forum

count block

Re: count block

Re: count block