树櫴希德 发表于 2015-12-8 09:04:38

文字分类统计，73哥函数，也可以修改为块名分类统计

本帖最后由 树櫴希德 于 2015-12-19 10:50 编辑


(DEFUN VXS (E /)
      (READ(CDR (ASSOC 1 (ENTGET E))))


)




;(VL-SORT PZX '(lambda(E1 E2) (EQUAL E1 E2) ) )
(DEFUN SAME (L1 / L2 l3);;;;;
(WHILE L1 (IF(MEMBER (CAR L1)(CDR L1))(SETQ L2(APPEND L2 (LIST(CAR L1))))

         (SETQ L3(APPEND L3 (LIST(CAR L1))))
      )
    (SETQ L1(VL-REMOVE(CAR L1 )L1))
    )

(append l2 l3))


(DEFUN SAMETIMES (L1) ;;;;;;
(MAPCAR'(LAMBDA(X)(CONS X(- (LENGTH L1)(LENGTH(VL-REMOVE X L1))))) l1))

(defun c:wzfltj ( / lst newlst x1 x2 x3 pzx ssa ii no en ptb pzx)

(setq ssa (ssget '((0 . "TEXT") (8 . "承台编号"))))
                (setq ii   0
                      no0
                  )
                  (repeat (sslength ssa)
                     (setq en (ssname ssa ii)
                            ptb (vxs en)
          pzx (append pzx (list ptb))
         ii(1+ ii)               )
      )

(setq lst nilnewlst nil x1 0)
(setq newlst (same(SAMETIMES PZX)))


(setq x2 (getpoint "\起始位置"))
(setq x3 (polar x20 12))
    (command "text" "j" "c" (polar x2 (* pi 0.5) 3) "2" "0" "种类" "")
(command "text" "j" "c" (polar x3 (* pi 0.5) 3) "2" "0" "数量" "")
(repeat (length newlst)
    (command "text" "j" "c" x2 "1.5" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
    (command "text""j" "c" x3 "1.5" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
    (setq x2(polar x2 (* pi 1.5) 3))
    (setq x3 (polar x20 12))
    (setq x1(1+ x1))
    )
      
(PRINC)   
)

   

434939575 发表于 2015-12-8 11:44:37

辛苦了！坚持！

树櫴希德 发表于 2015-12-18 20:18:41


(DEFUN VXS (E /)
      (READ(CDR (ASSOC 1 (ENTGET E))))


)




;(VL-SORT PZX '(lambda(E1 E2) (EQUAL E1 E2) ) )
(DEFUN SAME (L1 / L2 l3);;;;;
(WHILE L1 (IF(MEMBER (CAR L1)(CDR L1))(SETQ L2(APPEND L2 (LIST(CAR L1))))

         (SETQ L3(APPEND L3 (LIST(CAR L1))))
              )
    (SETQ L1(VL-REMOVE(CAR L1 )L1))
    )

(append l2 l3))


(DEFUN SAMETIMES (L1 / ) ;;;;;;
(MAPCAR'(LAMBDA(X)(CONS X(- (LENGTH L1)(LENGTH(VL-REMOVE X L1))))) l1))

(defun c:wzfltj ( / lst newlst x1 x2 x3 pzx ssa ii no en ptb pzx)

(setq ssa (ssget '((0 . "TEXT") (8 . "承台编号"))))
                (setq ii   0
                      no0
                  )
                  (repeat (sslength ssa)
                     (setq en (ssname ssa ii)
                            ptb (vxs en)
          pzx (append pzx (list ptb))
         ii(1+ ii)               )
                  )

(setq lst nilnewlst nil x1 0)
(setq newlst (same(SAMETIMES PZX)))


(setq x2 (getpoint "\起始位置"))
(setq x3 (polar x20 12000))

    (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
(command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
(entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))(cons 11 (polar x3 (* pi 0.5) 3000)) ))
(repeat (length newlst)
    (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
    (command "text""j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
    (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)(cons 11 x3) ))
    (setq x2(polar x2 (* pi 1.5) 3000))
    (setq x3 (polar x20 12000))
    (setq x1(1+ x1))
    )
      
(PRINC)               
)

       

树櫴希德 发表于 2015-12-21 20:51:48

块内文字分类统计3.LSP
(DEFUN VXS (E /)
      (READ(CDR (ASSOC 1 (ENTGET E))))


)
;;vla版递归遍历图元
;;(sk_get_blk->ent obj) obj= 插入块的vla-object
;;by edata 2015-9-1
(defun sk_get_blk->ent(blk / blk_nameblocks n lst)
(if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))
    (progn
      (setq blk_name(vla-get-name blk))
      (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
      (vlax-for n (vla-item blocks blk_name)
      (cond ((= (vla-get-objectname n) "AcDbBlockReference")
            (setq lst(append (sk_get_blk->ent n) lst ))
               )
            (t (setq lst(cons n lst)))
            )
      )
      (reverse lst)
      )
    )
)

;;test
(defun insertbl ( en / obj all_blk_en lst i)
(setq obj(vlax-ename->vla-object en))
(setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))
(setq lst '())
;(setq i 0)

(mapcar'(lambda (x)
          (if (= (cdr(assoc 0 (entget X))) "TEXT")
(PROGN
(setq lst (append lst (list(read(cdr(assoc 1 (entget X)))))))
;(setq i (1+ i))
)
)
          )
         all_blk_en
)
lst
)



;(VL-SORT PZX '(lambda(E1 E2) (EQUAL E1 E2) ) )
(DEFUN SAME (L1 / L2 l3);;;;;
(WHILE L1 (IF(MEMBER (CAR L1)(CDR L1))(SETQ L2(APPEND L2 (LIST(CAR L1))))

         (SETQ L3(APPEND L3 (LIST(CAR L1))))
              )
    (SETQ L1(VL-REMOVE(CAR L1 )L1))
    )

(append l2 l3))


(DEFUN SAMETIMES (L1 / ) ;;;;;;
(MAPCAR'(LAMBDA(X)(CONS X(- (LENGTH L1)(LENGTH(VL-REMOVE X L1))))) l1))

(defun c:wzfltj ( / lst newlst x1 x2 x3 pzx ssa ii no en ptb pzx)

(setq ssa (ssget '((0 . "insert") )))
                (setq ii   0
                      no0
                  )
                  (repeat (sslength ssa)
                     (setq en (ssname ssa ii)
                            ptb (insertbl en)
          pzx (append pzx (list ptb))
         ii(1+ ii)               )
                  )

(setq lst nilnewlst nil x1 0)
(setq newlst (same(SAMETIMES PZX)))


(setq x2 (getpoint "\起始位置"))
(setq x3 (polar x20 12000))

    (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
(command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
(entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))(cons 11 (polar x3 (* pi 0.5) 3000)) ))
(repeat (length newlst)
    (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
    (command "text""j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
    (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)(cons 11 x3) ))
    (setq x2(polar x2 (* pi 1.5) 3000))
    (setq x3 (polar x20 12000))
    (setq x1(1+ x1))
    )
      
(PRINC)               
)

       

树櫴希德 发表于 2015-12-21 20:53:49


(DEFUN VXS (E /)
      (READ(CDR (ASSOC 1 (ENTGET E))))


)
;;vla版递归遍历图元
;;(sk_get_blk->ent obj) obj= 插入块的vla-object
;;by edata 2015-9-1
(defun sk_get_blk->ent(blk / blk_nameblocks n lst)
(if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))
    (progn
      (setq blk_name(vla-get-name blk))
      (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
      (vlax-for n (vla-item blocks blk_name)
      (cond ((= (vla-get-objectname n) "AcDbBlockReference")
            (setq lst(append (sk_get_blk->ent n) lst ))
               )
            (t (setq lst(cons n lst)))
            )
      )
      (reverse lst)
      )
    )
)

;;test
(defun insertbl ( en / obj all_blk_en lst i)
(setq obj(vlax-ename->vla-object en))
(setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))
(setq lst '())
;(setq i 0)

(mapcar'(lambda (x)
          (if (= (cdr(assoc 0 (entget X))) "TEXT")
(PROGN
(setq lst (append lst (list(read(cdr(assoc 1 (entget X)))))))
;(setq i (1+ i))
)
)
          )
         all_blk_en
)
lst
)



;(VL-SORT PZX '(lambda(E1 E2) (EQUAL E1 E2) ) )
(DEFUN SAME (L1 / L2 l3);;;;;
(WHILE L1 (IF(MEMBER (CAR L1)(CDR L1))(SETQ L2(APPEND L2 (LIST(CAR L1))))

         (SETQ L3(APPEND L3 (LIST(CAR L1))))
              )
    (SETQ L1(VL-REMOVE(CAR L1 )L1))
    )

(append l2 l3))


(DEFUN SAMETIMES (L1 / ) ;;;;;;
(MAPCAR'(LAMBDA(X)(CONS X(- (LENGTH L1)(LENGTH(VL-REMOVE X L1))))) l1))

(defun c:wzfltj ( / lst newlst x1 x2 x3 pzx ssa ii no en ptb pzx)

(setq ssa (ssget '((0 . "insert") )))
                (setq ii   0
                      no0
                  )
                  (repeat (sslength ssa)
                     (setq en (ssname ssa ii)
                            ptb (insertbl en)
          pzx (append pzx ptb)
         ii(1+ ii)               )
                  )

(setq lst nilnewlst nil x1 0)
(setq newlst (same(SAMETIMES PZX)))


(setq x2 (getpoint "\起始位置"))
(setq x3 (polar x20 12000))

    (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
(command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
(entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))(cons 11 (polar x3 (* pi 0.5) 3000)) ))
(repeat (length newlst)
    (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
    (command "text""j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
    (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)(cons 11 x3) ))
    (setq x2(polar x2 (* pi 1.5) 3000))
    (setq x3 (polar x20 12000))
    (setq x1(1+ x1))
    )
      
(PRINC)               
)

       

gzsod 发表于 2022-5-12 17:31:19

达个历害了``````

guankuiwu 发表于 2022-8-22 16:56:46

这个很有借鉴！！

迷失1786 发表于 2023-7-1 20:06:53

图层指定了，不是承台编号，统计不了，这个只选前面一个字母就好了
页: [1]
查看完整版本: 文字分类统计，73哥函数，也可以修改为块名分类统计