请教如何可以用所选的块根据名称查询区域内所选块的数量

FiceS

下面这个只能选择全部对象，但是我想要先选择块，然后记住块的名字，再选择一块区域，根据块的名字查找块的数量 。

(princ "统计块数量请按tt")
(defun c:tt()
(vl-load-com)
(if (setq Ent (entsel))
     (progn
      ;转换成vla对象
      (setq Obj (vlax-ename->vla-object (car Ent)))
      ;获取块名称
      (setq BlkName (vla-get-effectivename Obj))
      ;根据块名称对整个图纸中符合条件的块建立选择集
      (setq en (ssget "X" (list (cons 0 "INSERT")(cons 2 BlkName))))
      ;获得选择集中图元的个数
      (setq sumen (sslength en))
      ;选中选择集
      (sssetfirst nil nil)
      (sssetfirst nil en)
      ;打印
      (print (strcat "块参照—>名称:"  BlkName ))
      (print (strcat "      —>共计:【" (rtos sumen) "】个;其中:"))
      ;中间变量ii赋初值0，建立空表集jh1
      (setq ii 0 jh1 nil)
      ;对每个块提取属性值
      (repeat sumen
     ;依次提取选择集每个图元名称
            (setq Ent (ssname en ii) ii (+ 1 ii))
     ;将图元名称转换为vla对象
            (setq Obj (vlax-ename->vla-object Ent))
            ;判断是否是属性块
            (if (and (= (vla-get-objectname Obj) "AcDbBlockReference") (= (vla-get-hasattributes Obj) :vlax-true))
                (progn
                 ;提取属性对象
                 (setq Objatt (vlax-safearray->list (vlax-variant-value (vla-getattributes Obj)))
                      ;提取属性值，该属性值为表一个表存在
                      Attstring (mapcar 'vla-get-textstring Objatt)
                  )
   ;将属性值表连接成一个字符串
          (setq jh1 (cons (vl-princ-to-string  Attstring) jh1))
  );内progn结束
             );结束if
        );结束repeat
      );结束progn
);结束if
;调用函数
(dd jh1)
);函数结束

(defun dd(jh / i j )
     (setq i (length jh))
     (while(> i 0)
           (setq ys (car jh))
           (if(member ys jh)
              (setq jh (vl-remove ys jh))
            );结束IF
           (setq j (length jh))
           (print (strcat "            —>" ys ":" (rtos (- i j))))
           (setq i j)
           (princ)
     );结束while
);结束函数

llsheng_73

你要得到那个区域的边界点坐标表pt
另外(setq BlkName (cdr(assoc 2(entget(car Ent)))))就行，没必要为一个块名称用VLA
 (setq en (ssget "X" (list (cons 0 "INSERT")(cons 2 BlkName))))
改成(setq en(ssget"WP"(list'(0 . "INSERT")(cons 2 BlkName))))

ZZXXQQ

2. (defun c:tt ()
   
3. (if (and (princ "\n选择块: ")
   
4. (setq s1 (ssget ":s" '((0 . "INSERT")))))
   
5.   (sslength (ssget (list '(0 . "INSERT") (assoc 2 (entget(ssname s1 0))))))
   
6. )
   
7. )

(defun c:tt ()<br /> (if (and (princ "\n选择块: ")<br /> (setq s1 (ssget ":s" '((0 . "INSERT")))))<br />   (sslength (ssget (list '(0 . "INSERT") (assoc 2 (entget(ssname s1 0))))))<br /> )<br /> )

FiceS

llsheng_73 发表于 2014-4-9 02:02
你要得到那个区域的边界点坐标表pt
另外(setq BlkName (cdr(assoc 2(entget(car Ent)))))就行，没必要为一 ...

谢谢，我试试看先。