求承台下桩标注统计增加修改代码

flytoday · 发表于 2011-12-30 10:42

原贴处

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91481&extra=page%3D1%26filter%3Dtypeid%26typeid%3D10%26typeid%3D10

（源码）

1、解释下本代码中的依据测试图中指定的数据写的，哪些，代表什么意思（就是不通用部份的）

2、增加输出

指定承台名的数量：如ZH7-2共几个，ZH7-2承台下桩有几个

feng582304 · 发表于 2011-12-30 10:42

本帖最后由 feng582304 于 2011-12-30 14:30 编辑

(defun feng-zct-pmin-pmax ( s1 / pmax pmin )
(setq s1 (vlax-ename->vla-object s1))
(vla-GetBoundingBox s1 'pmin 'pmax)
(MAPCAR '(LAMBDA (x)
(trans (MAPCAR 'fix (vlax-safearray->list x)) 0 1)
)
(list pmin pmax)
)
)
(defun feng-zct-ssget ( filter poli n / ss li )
(setq ss (ssget "c" (car poli) (cadr poli) filter))
(if ss
(cond
((= n 1) (ssname ss 0))
(t (repeat (setq n (sslength ss)) (setq li (cons (ssname ss (setq n (1- n))) li))))
)
nil
)
)
(defun feng-get-insertionpoint ( s1 )
(trans (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint s1))) 0 1)
)
(defun feng-zct-addtext ( ms st stylename po num / pp obj)
(if (null (TBLSEARCH "LAYER" "桩编号")) (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) "桩编号"))
(MAPCAR '(LAMBDA (x)
(vla-put-layer (vla-addline ms (vlax-3d-point (trans (car x) 1 0)) (vlax-3d-point (trans (cadr x) 1 0))) "桩编号")
)
(list
(list po (setq pp (MAPCAR '+ po '(350 350 0))))
(list pp (MAPCAR '+ pp '(1200 0 0)))
)
)
(vla-put-layer (setq obj (vla-addtext ms (strcat st "(" (itoa num) ")") (vlax-3d-point (trans (MAPCAR '+ pp '(100 100 0)) 1 0)) feng-heigth)) "桩编号")
(vla-put-StyleName obj stylename)
)
(defun feng-ssget->list ( ss / li n )
(repeat (setq n (sslength ss))
(setq li (cons (ssname ss (setq n (1- n))) li))
)
)
(defun feng-zct-obj ( ss / li n yx pp tt s1 )
(setq ss (MAPCAR '(LAMBDA (x);选承台线
(FENG-ZCT-SSGET '((8 . "Ct") (0 . "*POLYLINE")) x nil)
)
(MAPCAR '(LAMBDA (x);引线框
(list (MAPCAR '+ (car x) '(-10 -10 0)) (MAPCAR '+ (cadr x) '(10 10 0)))
)
(MAPCAR 'FENG-ZCT-PMIN-PMAX
(setq yx (MAPCAR '(LAMBDA (x);选引线
(FENG-ZCT-SSGET '((0 . "*LINE") (8 . "Jno")) x 1)
)
(MAPCAR '(LAMBDA (x);编号框
(list (MAPCAR '+ (car x) '(0 -300 0)) (cadr x))
)
(MAPCAR 'FENG-ZCT-PMIN-PMAX
(FENG-SSGET->LIST (ssget "x" (list (assoc 8 ss) (assoc 0 ss) (assoc 1 ss))))
))))))))
(setq ss (MAPCAR 'FENG-ZCT-PMIN-PMAX
(MAPCAR '(LAMBDA (x y)
(if (= (length x) 1)
(car x)
(progn
(setq n -1 tt t)
(while tt
(setq pp (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object y) (vlax-ename->vla-object (setq s1 (nth (setq n (1+ n)) x))) acExtendNone)))
(if (> (vlax-safearray-get-u-bound pp 1) 0) (setq pp (vlax-safearray->list pp) tt nil))
)
s1
)
)
)
ss yx
)
)
)
(setq li (MAPCAR '(LAMBDA (x) (list (car (cadr x)) (cadr (cadr x)) 0)) ss))
(setq ss (MAPCAR '(LAMBDA (x)
(MAPCAR 'vlax-ename->vla-object (FENG-ZCT-SSGET '((0 . "INSERT") (8 . "Ct") (2 . "ZH100")) x nil))
)
ss
)
)
(setq li (vl-sort (VL-SORT (MAPCAR 'cons li ss) '(LAMBDA (x y) (< (car (car x)) (car (car y))))) '(LAMBDA (x y) (> (cadr (car x)) (cadr (car y))))))
(setq li (MAPCAR '(LAMBDA (x)
(MAPCAR 'FENG-GET-INSERTIONPOINT
(vl-sort (vl-sort (cdr x) '(LAMBDA (y z) (< (car (FENG-GET-INSERTIONPOINT y)) (car (FENG-GET-INSERTIONPOINT z)))))
'(LAMBDA (y z) (> (cadr (FENG-GET-INSERTIONPOINT y)) (cadr (FENG-GET-INSERTIONPOINT z))))
)
)
)
li
)
)
li
)
(defun c:feng-zct ( / ss stylename li ms st num )
(VL-LOAD-COM)
(princ "\n=============请选择承台编号==============")
(setq ss (ssget ":E:S" '((0 . "*TEXT") (8 . "Jno"))))
(if (car (setq feng-heigth (list (getdist (STRCAT "\n请输入字高<" (if feng-heigth (itoa feng-heigth) (progn (setq feng-heigth 200) "200")) ">:")) feng-heigth)))
(setq feng-heigth (fix (car feng-heigth)))
(setq feng-heigth (cadr feng-heigth))
)
(if ss (vl-cmdf "undo" "be" "zoom" "e"))
(if ss
(progn
(setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
li (feng-zct-obj (entget (ssname ss 0)))
stylename (cdr (assoc 7 (setq ss (entget (ssname ss 0)))))
st (cdr (assoc 1 ss))
num 0
)
(MAPCAR '(LAMBDA (x)
(MAPCAR '(LAMBDA (y)
(FENG-ZCT-ADDTEXT ms st stylename y (setq num (1+ num)))
)
x
)
)
li
)
)
)
(if ss (progn
(vl-cmdf "zoom" "p" "undo" "e")
(princ (strcat "\n==================\n" st "承台:" (itoa (sslength (ssget "x" (list (assoc 8 ss) (assoc 0 ss) (assoc 1 ss)))))"个====桩：" (itoa num) "个\n===make by feng==="))
)
)
(princ)
)

(defun feng-zct-pmin-pmax ( s1 / pmax pmin ) 
  (setq s1 (vlax-ename->vla-object s1)) 
  (vla-GetBoundingBox s1 'pmin 'pmax) 
  (MAPCAR '(LAMBDA (x) 
       (trans (MAPCAR 'fix (vlax-safearray->list x)) 0 1) 
       ) 
    (list pmin pmax) 
    ) 
  ) 
(defun feng-zct-ssget ( filter poli n / ss li ) 
  (setq ss (ssget "c" (car poli) (cadr poli) filter)) 
  (if ss 
    (cond 
      ((= n 1) (ssname ss 0)) 
      (t (repeat (setq n (sslength ss)) (setq li (cons (ssname ss (setq n (1- n))) li)))) 
      ) 
    nil 
    ) 
  ) 
(defun feng-get-insertionpoint ( s1 ) 
  (trans (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint s1))) 0 1) 
  ) 
(defun feng-zct-addtext ( ms st stylename po num / pp obj) 
  (if (null (TBLSEARCH "LAYER" "桩编号")) (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) "桩编号")) 
  (MAPCAR '(LAMBDA (x) 
       (vla-put-layer (vla-addline ms (vlax-3d-point (trans (car x) 1 0)) (vlax-3d-point (trans (cadr x) 1 0))) "桩编号") 
       ) 
    (list 
      (list po (setq pp (MAPCAR '+ po '(350 350 0)))) 
      (list pp (MAPCAR '+ pp '(1200 0 0))) 
      ) 
    ) 
  (vla-put-layer (setq obj (vla-addtext ms (strcat st "(" (itoa num) ")") (vlax-3d-point (trans (MAPCAR '+ pp '(100 100 0)) 1 0)) feng-heigth)) "桩编号") 
  (vla-put-StyleName obj stylename) 
  ) 
(defun feng-ssget->list ( ss / li n ) 
  (repeat (setq n (sslength ss)) 
    (setq li (cons (ssname ss (setq n (1- n))) li)) 
    ) 
  ) 
(defun feng-zct-obj ( ss / li n yx pp tt s1 ) 
  (setq ss (MAPCAR '(LAMBDA (x);选承台线 
          (FENG-ZCT-SSGET '((8 . "Ct") (0 . "*POLYLINE")) x nil) 
          ) 
       (MAPCAR '(LAMBDA (x);引线框 
            (list (MAPCAR '+ (car x) '(-10 -10 0)) (MAPCAR '+ (cadr x) '(10 10 0))) 
            ) 
         (MAPCAR 'FENG-ZCT-PMIN-PMAX 
           (setq yx (MAPCAR '(LAMBDA (x);选引线 
                   (FENG-ZCT-SSGET '((0 . "*LINE") (8 . "Jno")) x 1) 
                   ) 
                (MAPCAR '(LAMBDA (x);编号框 
                     (list (MAPCAR '+ (car x) '(0 -300 0)) (cadr x)) 
                     ) 
                  (MAPCAR 'FENG-ZCT-PMIN-PMAX 
                    (FENG-SSGET->LIST (ssget "x" (list (assoc 8 ss) (assoc 0 ss) (assoc 1 ss)))) 
                    )))))))) 
  (setq ss (MAPCAR 'FENG-ZCT-PMIN-PMAX 
       (MAPCAR '(LAMBDA (x y) 
            (if (= (length x) 1) 
        (car x) 
        (progn 
          (setq n -1 tt t) 
          (while tt 
            (setq pp (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object y) (vlax-ename->vla-object (setq s1 (nth (setq n (1+ n)) x))) acExtendNone))) 
            (if (> (vlax-safearray-get-u-bound pp 1) 0) (setq pp (vlax-safearray->list pp) tt nil)) 
            ) 
          s1 
          ) 
        ) 
            ) 
         ss yx 
         ) 
       ) 
  ) 
  (setq li (MAPCAR '(LAMBDA (x) (list (car (cadr x)) (cadr (cadr x)) 0)) ss)) 
  (setq ss (MAPCAR '(LAMBDA (x) 
          (MAPCAR 'vlax-ename->vla-object (FENG-ZCT-SSGET '((0 . "INSERT") (8 . "Ct") (2 . "ZH100")) x nil)) 
          ) 
       ss 
       ) 
  ) 
  (setq li (vl-sort (VL-SORT (MAPCAR 'cons li ss) '(LAMBDA (x y) (< (car (car x)) (car (car y))))) '(LAMBDA (x y) (> (cadr (car x)) (cadr (car y)))))) 
  (setq li (MAPCAR '(LAMBDA (x) 
          (MAPCAR 'FENG-GET-INSERTIONPOINT 
            (vl-sort (vl-sort (cdr x) '(LAMBDA (y z) (< (car (FENG-GET-INSERTIONPOINT y)) (car (FENG-GET-INSERTIONPOINT z))))) 
               '(LAMBDA (y z) (> (cadr (FENG-GET-INSERTIONPOINT y)) (cadr (FENG-GET-INSERTIONPOINT z)))) 
               ) 
            ) 
          ) 
       li 
       ) 
  ) 
  li 
  ) 
(defun c:feng-zct ( / ss stylename li ms st num ) 
  (VL-LOAD-COM) 
  (princ "\n=============请选择承台编号==============") 
  (setq ss (ssget ":E:S" '((0 . "*TEXT") (8 . "Jno")))) 
  (if (car (setq feng-heigth (list (getdist (STRCAT "\n请输入字高<" (if feng-heigth (itoa feng-heigth) (progn (setq feng-heigth 200) "200")) ">:")) feng-heigth))) 
    (setq feng-heigth (fix (car feng-heigth))) 
    (setq feng-heigth (cadr feng-heigth)) 
    ) 
  (if ss (vl-cmdf "undo" "be" "zoom" "e")) 
  (if ss 
    (progn 
      (setq ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) 
      li (feng-zct-obj (entget (ssname ss 0))) 
      stylename (cdr (assoc 7 (setq ss (entget (ssname ss 0))))) 
      st (cdr (assoc 1 ss)) 
      num 0 
      ) 
      (MAPCAR '(LAMBDA (x) 
     (MAPCAR '(LAMBDA (y) 
          (FENG-ZCT-ADDTEXT ms st stylename y (setq num (1+ num))) 
          ) 
       x 
       ) 
     ) 
        li 
        ) 
      ) 
    ) 
  (if ss (progn 
     (vl-cmdf "zoom" "p" "undo" "e") 
     (princ (strcat "\n==================\n" st "承台:" (itoa (sslength (ssget "x" (list (assoc 8 ss) (assoc 0 ss) (assoc 1 ss)))))"个====桩：" (itoa num) "个\n===make by feng===")) 
     ) 
    ) 
  (princ) 
  )

flytoday · 发表于 2011-12-30 13:19

看来最近高手都很忙哈。。。。哪位有空路过瞧瞧哈。。。。帮帮忙不胜感激

flytoday · 发表于 2011-12-30 14:01

本帖最后由 flytoday 于 2011-12-30 14:02 编辑

feng582304 能不改成能输出TXT或EXL格式的。。桩数与承台各种编号的数量啊

能不能给我讲下。。这个代码是哪些表示本图纸固有的，。不通用的啊谢谢~~

feng582304 · 发表于 2011-12-30 14:11

本帖最后由 feng582304 于 2011-12-30 14:15 编辑

flytoday 发表于 2011-12-30 14:01
feng582304 能不改成能输出TXT或EXL格式的。。桩数与承台各种编号的数量啊

能不能给我讲下。。这个代码是 ...

如果说你所有桩都编号完成后，可以做个输出啊。
里面本图纸固有的也就那些承台编号的图层名、承台编号引线的图层名以是引线是多段线、桩块的块名以及图层名。在代码里面你找一个这些东西所在的那一句就是啦。
其实在网站里面有很多文字统计的例子啦，你可以找一下。
还有就是我只针对你的样图进行测试，你最好自己也要做个测试，以免图纸标注错漏，不要过分依懒自动化。

flytoday · 发表于 2011-12-30 14:12

哦谢啦

feng582304 · 发表于 2011-12-30 14:31

flytoday 发表于 2011-12-30 14:12
哦谢啦

重新更新了一下：点编号后，最后给出编号有多少个，桩有多少个。

flytoday · 发表于 2011-12-30 15:08

太强大了顶起哈谢谢~~

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

求承台下桩标注统计增加修改代码

最佳答案

相关帖子