设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › 文字分类统计，73哥函数，也可以修改为块名分类统计
返回列表 发新帖
查看: 2866|回复: 7

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

[复制链接]
树櫴希德
发表于 2015-12-8 09:04:38 | 显示全部楼层 |阅读模式
本帖最后由 树櫴希德 于 2015-12-19 10:50 编辑

  3. (DEFUN VXS (E /)
  4.       (READ(CDR (ASSOC 1 (ENTGET E))))


  7.   )




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

  16.            (SETQ L3(APPEND L3 (LIST(CAR L1))))
  17.         )
  18.     (SETQ L1(VL-REMOVE(CAR L1 )L1))
  19.     )

  21. (append l2 l3))


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

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

  29. (setq ssa (ssget '((0 . "TEXT") (8 . "承台编号"))))
  30.                 (setq ii   0
  31.                       no  0
  32.                   )
  33.                   (repeat (sslength ssa)
  34.                        (setq en (ssname ssa ii)
  35.                             ptb (vxs en)
  36.           pzx (append pzx (list ptb))
  37.            ii  (1+ ii)               )
  38.         )
  39.   
  40. (setq lst nil  newlst nil x1 0)
  41. (setq newlst (same(SAMETIMES PZX)))


  44. (setq x2 (getpoint "\起始位置"))
  45.   (setq x3 (polar x2  0 12))
  46.     (command "text" "j" "c" (polar x2 (* pi 0.5) 3) "2" "0" "种类" "")
  47.   (command "text" "j" "c" (polar x3 (* pi 0.5) 3) "2" "0" "数量" "")
  48.   (repeat (length newlst)
  49.     (command "text" "j" "c" x2 "1.5" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
  50.     (command "text"  "j" "c" x3 "1.5" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
  51.     (setq x2(polar x2 (* pi 1.5) 3))
  52.     (setq x3 (polar x2  0 12))
  53.     (setq x1(1+ x1))
  54.     )
  55.       
  56. (PRINC)   
  57. )

  59.    
统计

本帖子中包含更多资源

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

x

评分

参与人数 1明经币 +3 金钱 +30 收起 理由
yfy2003 + 3 + 30

查看全部评分

相关帖子
回复

使用道具 举报

434939575
发表于 2015-12-8 11:44:37 | 显示全部楼层
辛苦了！坚持！
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2015-12-18 20:18:41 | 显示全部楼层

  3. (DEFUN VXS (E /)
  4.       (READ(CDR (ASSOC 1 (ENTGET E))))


  7.   )




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

  16.            (SETQ L3(APPEND L3 (LIST(CAR L1))))
  17.               )
  18.     (SETQ L1(VL-REMOVE(CAR L1 )L1))
  19.     )

  21. (append l2 l3))


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

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

  29. (setq ssa (ssget '((0 . "TEXT") (8 . "承台编号"))))
  30.                 (setq ii   0
  31.                       no  0
  32.                   )
  33.                   (repeat (sslength ssa)
  34.                        (setq en (ssname ssa ii)
  35.                             ptb (vxs en)
  36.           pzx (append pzx (list ptb))
  37.            ii  (1+ ii)               )
  38.                     )
  39.   
  40. (setq lst nil  newlst nil x1 0)
  41. (setq newlst (same(SAMETIMES PZX)))


  44. (setq x2 (getpoint "\起始位置"))
  45.   (setq x3 (polar x2  0 12000))
  46.   
  47.     (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
  48.   (command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
  49.   (entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))  (cons 11 (polar x3 (* pi 0.5) 3000)) ))
  50.   (repeat (length newlst)
  51.     (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
  52.     (command "text"  "j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
  53.     (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)  (cons 11 x3) ))
  54.     (setq x2(polar x2 (* pi 1.5) 3000))
  55.     (setq x3 (polar x2  0 12000))
  56.     (setq x1(1+ x1))
  57.     )
  58.       
  59. (PRINC)               
  60. )

  62.          
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2015-12-21 20:51:48 | 显示全部楼层
块内文字分类统计3.LSP

  3. (DEFUN VXS (E /)
  4.       (READ(CDR (ASSOC 1 (ENTGET E))))


  7.   )
  8. ;;vla版递归遍历图元
  9. ;;(sk_get_blk->ent obj) obj= 插入块的vla-object
  10. ;;by edata 2015-9-1
  11. (defun sk_get_blk->ent(blk / blk_name  blocks n lst)
  12.   (if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))
  13.     (progn
  14.       (setq blk_name(vla-get-name blk))
  15.       (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
  16.       (vlax-for n (vla-item blocks blk_name)
  17.         (cond ((= (vla-get-objectname n) "AcDbBlockReference")
  18.               (setq lst(append (sk_get_blk->ent n) lst ))
  19.                )
  20.               (t (setq lst(cons n lst)))
  21.               )
  22.         )
  23.       (reverse lst)
  24.       )
  25.     )
  26.   )

  28. ;;test
  29. (defun insertbl ( en / obj all_blk_en lst i)
  30.   (setq obj(vlax-ename->vla-object en))
  31.   (setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))
  32.   (setq lst '())
  33.   ;(setq i 0)

  35. (mapcar  '(lambda (x)
  36.           (if (= (cdr(assoc 0 (entget X))) "TEXT")
  37. (PROGN
  38. (setq lst (append lst (list(read(cdr(assoc 1 (entget X)))))))
  39. ;(setq i (1+ i))
  40. )
  41.   )
  42.           )
  43.          all_blk_en
  44. )
  45.   lst
  46.   )



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

  54.            (SETQ L3(APPEND L3 (LIST(CAR L1))))
  55.               )
  56.     (SETQ L1(VL-REMOVE(CAR L1 )L1))
  57.     )

  59. (append l2 l3))


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

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

  67. (setq ssa (ssget '((0 . "insert") )))
  68.                 (setq ii   0
  69.                       no  0
  70.                   )
  71.                   (repeat (sslength ssa)
  72.                        (setq en (ssname ssa ii)
  73.                             ptb (insertbl en)
  74.           pzx (append pzx (list ptb))
  75.            ii  (1+ ii)               )
  76.                     )
  77.   
  78. (setq lst nil  newlst nil x1 0)
  79. (setq newlst (same(SAMETIMES PZX)))


  82. (setq x2 (getpoint "\起始位置"))
  83.   (setq x3 (polar x2  0 12000))
  84.   
  85.     (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
  86.   (command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
  87.   (entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))  (cons 11 (polar x3 (* pi 0.5) 3000)) ))
  88.   (repeat (length newlst)
  89.     (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
  90.     (command "text"  "j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
  91.     (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)  (cons 11 x3) ))
  92.     (setq x2(polar x2 (* pi 1.5) 3000))
  93.     (setq x3 (polar x2  0 12000))
  94.     (setq x1(1+ x1))
  95.     )
  96.       
  97. (PRINC)               
  98. )

  100.          
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2015-12-21 20:53:49 | 显示全部楼层

  3. (DEFUN VXS (E /)
  4.       (READ(CDR (ASSOC 1 (ENTGET E))))


  7.   )
  8. ;;vla版递归遍历图元
  9. ;;(sk_get_blk->ent obj) obj= 插入块的vla-object
  10. ;;by edata 2015-9-1
  11. (defun sk_get_blk->ent(blk / blk_name  blocks n lst)
  12.   (if(and blk (= (vla-get-objectname blk) "AcDbBlockReference"))
  13.     (progn
  14.       (setq blk_name(vla-get-name blk))
  15.       (setq blocks(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))))
  16.       (vlax-for n (vla-item blocks blk_name)
  17.         (cond ((= (vla-get-objectname n) "AcDbBlockReference")
  18.               (setq lst(append (sk_get_blk->ent n) lst ))
  19.                )
  20.               (t (setq lst(cons n lst)))
  21.               )
  22.         )
  23.       (reverse lst)
  24.       )
  25.     )
  26.   )

  28. ;;test
  29. (defun insertbl ( en / obj all_blk_en lst i)
  30.   (setq obj(vlax-ename->vla-object en))
  31.   (setq all_blk_en(mapcar 'vlax-vla-object->ename (sk_get_blk->ent obj)))
  32.   (setq lst '())
  33.   ;(setq i 0)

  35. (mapcar  '(lambda (x)
  36.           (if (= (cdr(assoc 0 (entget X))) "TEXT")
  37. (PROGN
  38. (setq lst (append lst (list(read(cdr(assoc 1 (entget X)))))))
  39. ;(setq i (1+ i))
  40. )
  41.   )
  42.           )
  43.          all_blk_en
  44. )
  45.   lst
  46.   )



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

  54.            (SETQ L3(APPEND L3 (LIST(CAR L1))))
  55.               )
  56.     (SETQ L1(VL-REMOVE(CAR L1 )L1))
  57.     )

  59. (append l2 l3))


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

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

  67. (setq ssa (ssget '((0 . "insert") )))
  68.                 (setq ii   0
  69.                       no  0
  70.                   )
  71.                   (repeat (sslength ssa)
  72.                        (setq en (ssname ssa ii)
  73.                             ptb (insertbl en)
  74.           pzx (append pzx ptb)
  75.            ii  (1+ ii)               )
  76.                     )
  77.   
  78. (setq lst nil  newlst nil x1 0)
  79. (setq newlst (same(SAMETIMES PZX)))


  82. (setq x2 (getpoint "\起始位置"))
  83.   (setq x3 (polar x2  0 12000))
  84.   
  85.     (command "text" "j" "c" (polar x2 (* pi 0.5) 3000) "2000" "0" "种类" "")
  86.   (command "text" "j" "c" (polar x3 (* pi 0.5) 3000) "2000" "0" "数量" "")
  87.   (entmake (list '(0 . "line") '(8 . "0") (cons 10 (polar x2 (* pi 0.5) 3000))  (cons 11 (polar x3 (* pi 0.5) 3000)) ))
  88.   (repeat (length newlst)
  89.     (command "text" "j" "c" x2 "1500" "0" (vl-princ-to-string (car (nth x1 newlst))) "")
  90.     (command "text"  "j" "c" x3 "1500" "0" (vl-princ-to-string(cdr(nth x1 newlst))) "")
  91.     (entmake (list '(0 . "line") '(8 . "0") (cons 10 x2)  (cons 11 x3) ))
  92.     (setq x2(polar x2 (* pi 1.5) 3000))
  93.     (setq x3 (polar x2  0 12000))
  94.     (setq x1(1+ x1))
  95.     )
  96.       
  97. (PRINC)               
  98. )

  100.          
回复 支持 反对

使用道具 举报

gzsod
发表于 2022-5-12 17:31:19 | 显示全部楼层
达个历害了``````
回复 支持 反对

使用道具 举报

guankuiwu
发表于 2022-8-22 16:56:46 | 显示全部楼层
这个很有借鉴！！
回复 支持 反对

使用道具 举报

迷失1786
发表于 2023-7-1 20:06:53 | 显示全部楼层
图层指定了，不是承台编号，统计不了，这个只选前面一个字母就好了
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-22 20:44 , Processed in 0.199601 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表