- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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)
Solved! Go to Solution.
