韩信点兵---一步步教CAD中过滤器的用法

Highflybird

针对目前有很多人还在用R14,而且没有装express tools工具，对过滤器的用法又不熟悉，编写了一个lisp程序，
能用来统计块的数量。
附件中包含了lisp程序和演示文件.
用法：加载程序，运行BC ，先选择要统计的块,然后选择要统计的区域,结束后按F2显示出统计数量。
附件中包含了lisp程序和演示文件。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:bcount.rar 
下载次数:30  文件大小:70.44 KB 
下载权限: 不限 以上  [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:bcount1.LSP 
下载次数:33  文件大小:2.35 KB 
下载权限: 不限 以上  [免费赚D豆]

Free-Lancer

统计图块程序很多，可能每个人要求的成果不一样，这里有一个点选删除图块的程序，中间比较人性化的地方增加了点选后即时显示图名，如果点错了再次点击该图块就会去除掉[pcode=lisp,true](defun c:delBlk        (/           bn             e               el         bln
                 ss           b             sbln      thisdrawing
                 clearcset             string_join         filter
                )
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (defun Clearcset (/ cset)
    (if        (not (vl-catch-all-error-p
               (setq cset
                      (vl-catch-all-apply
                        'vla-item
                        (list
                          (vlax-get-property
                            ThisDrawing
                            'selectionsets
                          )
                          "CURRENT"
                        )
                      )
               )
             )
        )
      (vla-delete cset)
    )
    (princ)
  )
  (defun string_join (strlst div /)
    (vl-string-trim
      div
      (apply 'strcat (mapcar '(lambda (x) (strcat x div)) strlst))
    )
  )
  (while (setq e (entsel "\n拾取删除图块<退出>: "))
    (if        (and (setq el (entget (car e)))
             (= (cdr (assoc 0 el)) "INSERT")
             (setq bn (cdr (setq b (assoc 2 el))))
             (not (member bn bln))
        )
      (progn
        (setq bln (cons bn bln))
        (redraw (car e) 3)
        (clearcset)
        (setq ss (ssget "X" (list '(0 . "INSERT") b)))
        (vla-highlight
          (vla-get-activeselectionset thisdrawing)
          :vlax-true
        )
        (prompt        (strcat        "\n选中了\""
                        (setq sbln (String_Join
                                     (reverse bln)
                                     ","
                                   )
                        )
                        "\"块!"
                )
        )
      )
      (princ "\n选择非图块, 重新选择!")
    )
  )
  (if bln
    (progn
      (princ "\n选择删除范围[回车全选]...")
      (if
        (not (setq
               ss (ssget
                    (setq
                      filter (append
                               '((0 . "INSERT") (-4 . "<or"))
                               (mapcar '(lambda (a) (cons 2 a)) bln)
                               '((-4 . "or>"))
                             )
                    )
                  )
             )
        )
         (setq ss (ssget "x" filter))
      )
      (if ss
        (progn
          (vl-cmdf ".erase" 　ss "")
          (princ "\n共删除 ")
          (princ (sslength ss))
          (princ " 个块!")
        )
      )
      (vla-purgeall thisdrawing)
    )
  )
  (princ)
)[/pcode]

ScmTools

支持! 根据行业各有需求