求一个能统计相同图形的数量的LSP

gmx2588 · 发表于 2014-8-31 08:28:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

求一个能统计相同图形的数量的LSP.比如:统计CAD图中一共有多少个相同的矩形,或者统计有多少个相同的园.

csharp · 发表于 2014-8-31 11:22:08

AutoCAD中每个空间实体都有自己的特性，所以才呈现出区别，严格上相同就是重复实体了，楼主所述相同应该一个某些属性相同的实体，如圆，实体特征有图层、颜色、线形、线宽等，圆本身有圆心、半径、法向、厚度等等，你要说明哪些属性相同就归为一组，矩形只是一个表现，CAD中可以是一个Pline, 也可能是多个曲线组合而表现为“矩形”

gmx2588 · 发表于 2014-8-31 11:31:10

如果是统计的图形(矩形园),是复制出来的,这样能做LSP程序统计吗?

csharp · 发表于 2014-8-31 11:32:17

gmx2588 发表于 2014-8-31 11:31
如果是统计的图形(矩形园),是复制出来的,这样能做LSP程序统计吗?

可以，你要说清楚

st788796 · 发表于 2014-8-31 14:45:59

gmx2588 发表于 2014-8-31 11:31
如果是统计的图形(矩形园),是复制出来的,这样能做LSP程序统计吗?

选择完全相同圆

(defun c:tt (/ e el ss)
(if (and (setq e (ssget ":S" '((0 . "Circle"))))
(setq el (entget (ssname e 0))
el (vl-remove-if
'(lambda (x) (member (car x) '(-1 330 5 10 100)))
el
)
)
(setq ss (ssget el))
)
(sssetfirst nil ss)
)
)

st788796 · 发表于 2014-8-31 15:00:56

本帖最后由 st788796 于 2014-8-31 15:19 编辑

选择“相同” lwpolyline

(defun c:tt1 (/ e el ss filter pl->len vl s1 sl)
(defun Pl->len (e / el pts)
(setq el (entget e)
pts (mapcar 'cdr
(vl-remove-if '(lambda (x) (/= (car x) 10)) el)
)
)
(if (= (cdr (assoc 70 el)) 1)
(setq pts (reverse (cons (car pts) (reverse pts))))
)
(mapcar '(lambda (x y)
(list (distance x y) (angle x y))
)
pts
(cdr pts)
)
)
(if (and (setq e (car (entsel "\nPick Pline: ")))
(setq el (entget e))
(wcmatch (cdr (assoc 0 el)) "LWPOLYLINE")
(setq filter (vl-remove-if
'(lambda (x) (member (car x) '(-1 330 5 10 100)))
el
)
)
(setq ss (ssget filter))
)
(progn
(setq vl (pl->len e)
s1 (ssadd)
sl (sslength ss)
)
(while (setq ne (ssname ss (setq sl (1- sl))))
(if (equal (pl->len ne) vl 1e-6)
(ssadd ne s1)
)
)
(if s1
(sssetfirst nil s1)
)
)
)
(princ)
)

(defun c:tt1 (/ e el ss filter pl->len vl s1 sl) 
  (defun Pl->len (e / el pts) 
    (setq el  (entget e) 
          pts (mapcar 'cdr 
                      (vl-remove-if '(lambda (x) (/= (car x) 10)) el) 
              ) 
    ) 
    (if        (= (cdr (assoc 70 el)) 1) 
      (setq pts (reverse (cons (car pts) (reverse pts)))) 
    ) 
    (mapcar '(lambda (x y) 
               (list (distance x y) (angle x y)) 
             ) 
            pts 
            (cdr pts) 
    ) 
  ) 
  (if (and (setq e (car (entsel "\nPick Pline: "))) 
           (setq el (entget e)) 
           (wcmatch (cdr (assoc 0 el)) "LWPOLYLINE") 
           (setq filter        (vl-remove-if 
                          '(lambda (x) (member (car x) '(-1 330 5 10 100))) 
                          el 
                        ) 
           ) 
           (setq ss (ssget filter)) 
      ) 
    (progn 
      (setq vl (pl->len e) 
            s1 (ssadd) 
            sl (sslength ss) 
      ) 
      (while (setq ne (ssname ss (setq sl (1- sl)))) 
        (if (equal (pl->len ne) vl 1e-6) 
          (ssadd ne s1) 
        ) 
      ) 
      (if s1 
        (sssetfirst nil s1) 
      ) 
    ) 
  ) 
  (princ) 
)

上面两个是示意，如果直接框选分组

(defun c:tt (/ ss pl->len ss1 lst)
(defun pl->len (e)
(setq pts (xdrx_getpropertyvalue e "Vertices"))
(if (vlax-curve-isclosed e)
(setq pts (xd::pnts:close pts))
)
(mapcar '(lambda (x y)
(list (distance x y) (angle x y))
)
pts
)
)
(if (setq ss (ssget '((-4 . "<or")
(-4 . "<and")
(0 . "lwpolyline")
(90 . 4)
(-4 . "&=")
(70 . 1)
(-4 . "and>")
(0 . "Circle")
(-4 . "or>")
)
)
)
(progn
(if (setq ss1 (ssget "P" '((0 . "CIrcle"))))
(progn
(setq lst (mapcar '(lambda (x / el)
(setq el (entget x)
el (vl-remove-if
'(lambda (x)
(member (car x)
'(-1 330 5 10 100)
)
)
el
)
)
(list el x)
)
(xdrx_pickset->ents ss1)
)
lst (xd::list:groupbyindex lst 1e-3)
)
(setq ss (xdrx_pickset_subtract ss ss1))
)
)
(if ss
(progn
(setq lst (mapcar '(lambda (x / el)
(setq el (entget x)
el (vl-remove-if
'(lambda (x)
(member (car x)
'(-1 330 5 10 100)
)
)
el
)
)
(list (append (pl->len x) el) x)
)
(xdrx_pickset->ents ss)
)
lst (xd::list:groupbyindex lst 1e-3)
)
)
)
)
)
(princ)
)

(defun c:tt (/ ss pl->len ss1 lst) 
  (defun pl->len (e) 
    (setq pts (xdrx_getpropertyvalue e "Vertices")) 
    (if        (vlax-curve-isclosed e) 
      (setq pts (xd::pnts:close pts)) 
    ) 
    (mapcar '(lambda (x y) 
               (list (distance x y) (angle x y)) 
             ) 
            pts 
    ) 
  ) 
  (if (setq ss (ssget '((-4 . "<or") 
                        (-4 . "<and") 
                        (0 . "lwpolyline") 
                        (90 . 4) 
                        (-4 . "&=") 
                        (70 . 1) 
                        (-4 . "and>") 
                        (0 . "Circle") 
                        (-4 . "or>") 
                       ) 
               ) 
      ) 
    (progn 
      (if (setq ss1 (ssget "P" '((0 . "CIrcle")))) 
        (progn 
          (setq        lst (mapcar '(lambda (x / el) 
                               (setq el        (entget x) 
                                     el        (vl-remove-if 
                                          '(lambda (x) 
                                             (member (car x) 
                                                     '(-1 330 5 10 100) 
                                             ) 
                                           ) 
                                          el 
                                        ) 
                               ) 
                               (list el x) 
                             ) 
                            (xdrx_pickset->ents ss1) 
                    ) 
                lst (xd::list:groupbyindex lst 1e-3) 
          ) 
          (setq ss (xdrx_pickset_subtract ss ss1)) 
        ) 
      ) 
      (if ss 
        (progn 
          (setq        lst (mapcar '(lambda (x / el) 
                               (setq el        (entget x) 
                                     el        (vl-remove-if 
                                          '(lambda (x) 
                                             (member (car x) 
                                                     '(-1 330 5 10 100) 
                                             ) 
                                           ) 
                                          el 
                                        ) 
                               ) 
                               (list (append (pl->len x) el) x) 
                             ) 
                            (xdrx_pickset->ents ss) 
                    ) 
                lst (xd::list:groupbyindex lst 1e-3) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

gmx2588 · 发表于 2014-8-31 15:36:16

本帖最后由 gmx2588 于 2014-8-31 15:39 编辑

非常好用,谢谢!:loveliness:再求一个能统计同一种线型的长度的LSP.(比如用某一线型画的避雷带)

st788796 · 发表于 2014-8-31 15:46:42

gmx2588 发表于 2014-8-31 15:36
非常好用,谢谢!再求一个能统计同一种线型的长度的LSP.(比如用某一线型画的避雷带)

线性可能包含在图层，也可能是单独设置，你要统计总长？

st788796 · 发表于 2014-8-31 16:06:44

(defun c:tt (/ e el filter ss)
(if (and (setq e (car (entsel "\nPick Curve: ")))
(setq el (entget e))
(wcmatch (cdr (assoc 0 el)) "*LINE,ARC,CIRCLE,ELLIPSE")
(setq filter (vl-remove-if-not
'(lambda (x) (member (car x) '(8 6)))
el
)
)
(if (assoc 6 filter)
filter
(setq filter (cons '(6 . "BYLAYER") filter))
)
(setq ss (ssget (cons '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") filter)))
)
(princ
('((x / e l)
(while
(setq e (ssname ss (setq x (1+ x))))
(setq
l
(cons
(vlax-curve-getdistatparam e (vlax-curve-getendparam e))
l
)
)
)
(apply '+ l)
)
-1
)
)
)
(princ)
)

(defun c:tt (/ e el filter ss) 
  (if (and (setq e (car (entsel "\nPick Curve: "))) 
           (setq el (entget e)) 
           (wcmatch (cdr (assoc 0 el)) "*LINE,ARC,CIRCLE,ELLIPSE") 
           (setq filter        (vl-remove-if-not 
                          '(lambda (x) (member (car x) '(8 6))) 
                          el 
                        ) 
           ) 
           (if (assoc 6 filter) 
             filter 
             (setq filter (cons '(6 . "BYLAYER") filter)) 
           ) 
           (setq ss (ssget (cons '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") filter))) 
      ) 
    (princ 
      ('((x / e l) 
         (while 
          (setq e (ssname ss (setq x (1+ x)))) 
          (setq 
           l 
           (cons 
            (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 
            l 
           ) 
          ) 
         ) 
         (apply '+ l) 
        ) 
        -1 
      ) 
    ) 
  ) 
  (princ) 
)

gmx2588 · 发表于 2014-8-31 16:07:48

是的,可能不在同层上,只是统计某一种线型的总长度.

st788796 · 发表于 2014-8-31 16:13:08

gmx2588 发表于 2014-8-31 16:07
是的,可能不在同层上,只是统计某一种线型的总长度.

线型随层就要多写一些语句了

gmx2588 · 发表于 2014-8-31 16:21:26

本帖最后由 gmx2588 于 2014-8-31 16:24 编辑

好用:D非常感谢你的帮助! ( 如果能统计不同图层上的同一种线型总长度就更好了)

st788796 · 发表于 2014-8-31 16:50:35

本帖最后由 st788796 于 2014-8-31 17:10 编辑

gmx2588 发表于 2014-8-31 16:21
好用非常感谢你的帮助! ( 如果能统计不同图层上的同一种线型总长度就更好了)

(defun c:tt (/ e ss _get)
(defun _get (e / el lyr ln n ll)
(setq el (entget e)
lyr (cdr (assoc 8 el))
)
(if (not (setq ln (assoc 6 el)))
(setq ln (assoc 6 (tblsearch "layer" lyr)))
)
(while (setq n (tblnext "layer" (null n)))
(if (equal (assoc 6 n) ln)
(setq ll (cons (cdr (assoc 2 n)) ll))
)
)
(list '(0 . "*LINE,ARC,CIRCLE,ELLIPSE")
'(-4 . "<or")
'(-4 . "<and")
(cons 8
(vl-string-translate
" "
","
(vl-string-trim "()" (vl-princ-to-string ll))
)
)
'(6 . "BYLAYER")
'(-4 . "and>")
ln
'(-4 . "or>")
)
)
(if (and (setq e (car (entsel "\nPick Curve: ")))
(setq ss (ssget (_get e)))
)
(princ
('((x / e ll)
(while
(setq e (ssname ss (setq x (1+ x))))
(setq
ll
(cons
(vlax-curve-getdistatparam
e
(vlax-curve-getendparam e)
)
ll
)
)
)
(apply '+ ll)
)
-1
)
)
)
(princ)
)

(defun c:tt (/ e ss _get) 
  (defun _get (e / el lyr ln n ll) 
    (setq el  (entget e) 
          lyr (cdr (assoc 8 el)) 
    ) 
    (if        (not (setq ln (assoc 6 el))) 
      (setq ln (assoc 6 (tblsearch "layer" lyr))) 
    ) 
    (while (setq n (tblnext "layer" (null n))) 
      (if (equal (assoc 6 n) ln) 
        (setq ll (cons (cdr (assoc 2 n)) ll)) 
      ) 
    ) 
    (list '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") 
          '(-4 . "<or") 
          '(-4 . "<and") 
          (cons        8 
                (vl-string-translate 
                  " " 
                  "," 
                  (vl-string-trim "()" (vl-princ-to-string ll)) 
                ) 
          ) 
          '(6 . "BYLAYER") 
          '(-4 . "and>") 
          ln 
          '(-4 . "or>") 
    ) 
  ) 
  (if (and (setq e (car (entsel "\nPick Curve: "))) 
           (setq ss (ssget (_get e))) 
      ) 
    (princ 
      ('((x / e ll) 
         (while 
          (setq e (ssname ss (setq x (1+ x)))) 
          (setq 
           ll 
           (cons 
            (vlax-curve-getdistatparam 
             e 
             (vlax-curve-getendparam e) 
            ) 
            ll 
           ) 
          ) 
         ) 
         (apply '+ ll) 
        ) 
        -1 
      ) 
    ) 
  ) 
  (princ) 
)

ssget中加入 "X" 就不需要框选范围，直接全图统计

账号		自动登录	找回密码
密码			立即注册

[求助] 求一个能统计相同图形的数量的LSP

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

点评

评分