求助lisp 取消重复设定区域问题

jly0406 · 发表于 2014-1-7 09:45

本帖最后由 jly0406 于 2014-1-7 10:52 编辑

本人lisp菜鸟，出于工作需要拼凑了些代码想实现些功能，在指定区域内查找出某窗号的数量，如此循环即可
下边的代码初步实现了，点好基点，选择要查找的窗号，再选择一下要查的区域，就可以在基点处列出窗号和数量，并且画了
圆圈标示，然后再点好基点，选择要查找的窗号，再选择一下要查的区域

但是这样会有点麻烦，每次都要选区域，能否请大侠们帮改改，实现如下功能，先选好区域后，区域就暂时不变了，之后选择要查找的窗号，列出窗号数量，再选窗号，列出数量，区域就不用每次再选了，求大侠帮忙，感激不尽！

(defun c:tt ()
(setvar "cmdecho" 0)
(setq sspt (getpoint "\n请输入基点:"))

(WHILE 1
      (setq stxt "")
      (setq s1 (entsel "\n选择窗号 :"))
      (setq ent (entget(car s1)))
      (= (cdr(assoc 0 ent)) "TEXT")
      (setq stxt (cdr(assoc 1 (entget(car s1)))))

  (if (setq ss (ssget (list '(0 . "TEXT") (cons 1 (strcat "*" stxt "*"))))) (progn
   (setq i 0)
   (repeat (sslength ss)
   (setq en (ssname ss i))
   (vla-getboundingbox(vlax-ename->vla-object en) 'minp 'maxp)
   (setq minp (vlax-safearray->list minp)
      maxp (vlax-safearray->list maxp))
   (setq pt (polar minp (angle minp maxp) (/ (distance minp maxp) 2)))
   (command ".CIRCLE" pt 800)
   (setq i (1+ i))
)

(setq spt1 (polar sspt 0 8000))
(command "text" sspt 1000 0  stxt "")
(command "text" spt1 1000 0  (sslength ss) "")
(setq sspt (polar sspt (- (/ pi 2)) 1500))
  ))
)

(princ "\n")
(setvar "CMDECHO" 1)
(princ)
)

jly0406 · 发表于 2014-1-7 14:15

恩，图中无窗图块，就窗号字符串就行，求大侠解决感激不尽啊

jly0406 · 发表于 2014-1-7 14:19

大侠快出现啊

edata · 发表于 2014-1-7 15:06

对楼主的帖子标题表达感觉无语。。。
楼主估计要的是批量统计文本，并标示数量。
估计结果如下图：

jly0406 · 发表于 2014-1-7 16:19

edata 发表于 2014-1-7 15:06
对楼主的帖子标题表达感觉无语。。。
楼主估计要的是批量统计文本，并标示数量。
估计结果如下图：

对的，大侠终于出现了，就是大侠你说的这个意思，如何实现批量统计文本，并标示数量

edata · 发表于 2014-1-7 17:44

;; 查找出现次数最多表项】
;; 返回表中出现次数和元素
;; by chlh_jd 发表于 2012-7-18 20:01:02
;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=95639&pid=539700&fromuid=338795
(defun vl-maxtimes (lst / a len ti new)
(while lst
(setq a(car lst)len(length lst)
ti (- len (length (setq lst (vl-remove a lst))))
new (cons (cons ti a) new)))
;(if new(car(vl-sort new (function (lambda (e1 e2) (> (car e1) (car e2)))))))
)
;;;
;;;组码值提取(sk_dxf 图元名组码)
(defun sk_dxf(en code)
(if(and(=(type en) 'ENAME)(= (type code) 'INT))
(cdr(assoc code (entget en))))
)
;;;单行文本重复统计
;;; editor by edata
;;; 2014-1-7 17:43:51
(defun c:tt(/ EN K NEW_LST PT SS STR_LST)
(or font_heigth (setq font_heigth 300))
(if(setq ss(ssget'((0 . "text"))))
(progn
(setq str_lst '())
(while (setq en(ssname ss 0))
(setq str_lst(cons (sk_dxf en 1)str_lst))
(setq ss(ssdel en ss))
)
(setq str_lst(reverse str_lst))
(setq new_lst(vl-maxtimes str_lst))
(if (and (not (null new_lst)) (setq k -1 pt(getpoint "\n指定放置位置点:")))
(foreach n new_lst (entmakex (list
(cons 0 "text")
(cons 10 (polar pt (* pi 1.5) (* (setq k(1+ k)) (* font_heigth 1.5))))
(cons 1 (strcat (cdr n)" " (rtos (car n) 2 0)))
(cons 40 font_heigth)
)
))
)
)
(princ"\n Nothing Select Object!!!")
)
(princ)
)

;; 查找出现次数最多表项】 
;; 返回表中出现次数和元素 
;; by chlh_jd 发表于 2012-7-18 20:01:02 
;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=95639&pid=539700&fromuid=338795 
(defun vl-maxtimes (lst / a len ti new) 
  (while lst 
        (setq a(car lst)len(length lst) 
              ti (- len (length (setq lst (vl-remove a lst)))) 
              new (cons (cons ti a) new))) 
  ;(if new(car(vl-sort new (function (lambda (e1 e2) (> (car e1) (car e2))))))) 
) 
;;; 
;;;组码值提取(sk_dxf 图元名 组码) 
(defun sk_dxf(en code) 
    (if(and(=(type en) 'ENAME)(= (type code) 'INT)) 
      (cdr(assoc code (entget en)))) 
  ) 
;;;单行文本重复统计 
;;; editor by edata 
;;; 2014-1-7 17:43:51 
(defun c:tt(/ EN K NEW_LST PT SS STR_LST) 
  (or font_heigth (setq font_heigth 300)) 
  (if(setq ss(ssget'((0 . "text")))) 
    (progn 
      (setq str_lst '()) 
    (while (setq en(ssname ss 0)) 
      (setq str_lst(cons (sk_dxf en 1)str_lst)) 
      (setq ss(ssdel en ss)) 
      ) 
      (setq str_lst(reverse str_lst)) 
      (setq new_lst(vl-maxtimes str_lst)) 
      (if (and (not (null new_lst)) (setq  k -1 pt(getpoint "\n指定放置位置点:"))) 
      (foreach n new_lst (entmakex (list 
                                    (cons 0 "text") 
                                    (cons 10 (polar pt (* pi 1.5) (* (setq k(1+ k)) (* font_heigth 1.5)))) 
                                    (cons 1 (strcat (cdr n)"      " (rtos (car n) 2 0))) 
                                    (cons 40 font_heigth) 
                                    ) 
                                  )) 
        )       
    ) 
    (princ"\n Nothing Select Object!!!") 
    ) 
  (princ) 
  )

jly0406 · 发表于 2014-1-7 19:31

edata 发表于 2014-1-7 17:44

在网上找了个更便捷的代码，更有效些，但是缺点是需要单行文字，另外生成的文字重叠，大侠看看能解决重叠问题不

(defun c:wba (/    LST1 N    E    S WB SS  lst2
      lst_new    shuz lst    lst11  lst12 height  p1
      WBJULI
      )
  (setq  ss (ssget '((0 . "TEXT")))
  N  0
  )
  (REPEAT (SSLENGTH SS)
(SETQ E (SSNAME SS N)
S (ENTGET E)
WB (CDR (ASSOC 1 S))
height (CDR (ASSOC 40 s))
LST1 (CONS WB LST1)
)
(SETQ N (1+ N))
  )
  (while (> (LENGTH LST1) 0)
(IF  (NOT (MEMBER (NTH 0 LST1) LST2))
   (progn
  (SETQ LST2 (append LST2 (list (strcat (NTH 0 LST1) "=")))
      lst_new (vl-remove (NTH 0 LST1) LST1)
      shuz (itoa (- (LENGTH LST1) (length lst_new)))
      lst2 (append lst2 (list shuz))
      lst1 lst_new
  )
   )
)
(setq lst  (cons lst2 lst)
lst2 nil
)
  )
  (mapcar '(lambda (x)
   (setq lst11 (cons (strcat (car x) (cadr x)) lst11))
   )
lst
  )
  (setq lst11 (acad_strlsort lst11))
  (setq WBJULI (* height 1.4))
  (setq p1 (getpoint "\n请指定插入点："))
  (setq n 0)
  (foreach x lst11
(command "text" p1 height "" x)
(command)
(setq p1 (list (car p1) (- (cadr p1) WBJULI) (caddr p1)))
(setq p1 (polar p1 (- (/ pi 2)) 500))
(setq n (1+ n))
  )
  (princ)
)

jly0406 · 发表于 2014-1-7 19:42

本帖最后由 jly0406 于 2014-1-7 19:48 编辑

怎么能解决重叠问题呢

edata · 发表于 2014-1-7 21:13

jly0406 发表于 2014-1-7 19:42
怎么能解决重叠问题呢

----------------------------- 表示无语----------------------------------------

(defun c:wba (/ LST1 N E S WB SS lst2
lst_new shuz lst lst11 lst12 height p1
WBJULI
)
(setq ss (ssget '((0 . "TEXT")))
N 0
)
(REPEAT (SSLENGTH SS)
(SETQ E (SSNAME SS N)
S (ENTGET E)
WB (CDR (ASSOC 1 S))
height (CDR (ASSOC 40 s))
LST1 (CONS WB LST1)
)
(SETQ N (1+ N))
)
(while (> (LENGTH LST1) 0)
(IF (NOT (MEMBER (NTH 0 LST1) LST2))
(progn
(SETQ LST2 (append LST2 (list (strcat (NTH 0 LST1) "=")))
lst_new (vl-remove (NTH 0 LST1) LST1)
shuz (itoa (- (LENGTH LST1) (length lst_new)))
lst2 (append lst2 (list shuz))
lst1 lst_new
)
)
)
(setq lst (cons lst2 lst)
lst2 nil
)
)
(mapcar '(lambda (x)
(setq lst11 (cons (strcat (car x) (cadr x)) lst11))
)
lst
)
(setq lst11 (acad_strlsort lst11))
(setq WBJULI (* height 1.4))
(setq p1 (getpoint "\n请指定插入点："))
(setq n 0)
(foreach x lst11
(command "text" "NON" p1 height "" x)
(command)
(setq p1 (list (car p1) (- (cadr p1) WBJULI) (caddr p1)))
(setq p1 (polar p1 (* pi 1.5) 1))
(setq n (1+ n))
)
(princ)
)

(defun c:wba (/      LST1   N      E     S    WB   SS  lst2 
         lst_new       shuz   lst     lst11  lst12   height  p1 
         WBJULI 
        ) 
  (setq  ss (ssget '((0 . "TEXT"))) 
  N  0 
  ) 
  (REPEAT (SSLENGTH SS) 
    (SETQ E   (SSNAME SS N) 
    S   (ENTGET E) 
    WB   (CDR (ASSOC 1 S)) 
    height (CDR (ASSOC 40 s)) 
    LST1   (CONS WB LST1) 
    ) 
    (SETQ N (1+ N)) 
  ) 
  (while (> (LENGTH LST1) 0) 
    (IF  (NOT (MEMBER (NTH 0 LST1) LST2)) 
      (progn 
  (SETQ LST2    (append LST2 (list (strcat (NTH 0 LST1) "="))) 
        lst_new (vl-remove (NTH 0 LST1) LST1) 
        shuz    (itoa (- (LENGTH LST1) (length lst_new))) 
        lst2    (append lst2 (list shuz)) 
        lst1    lst_new 
  ) 
      ) 
    ) 
    (setq lst  (cons lst2 lst) 
    lst2 nil 
    ) 
  ) 
  (mapcar '(lambda (x) 
       (setq lst11 (cons (strcat (car x) (cadr x)) lst11)) 
     ) 
    lst 
  ) 
  (setq lst11 (acad_strlsort lst11)) 
  (setq WBJULI (* height 1.4)) 
  (setq p1 (getpoint "\n请指定插入点：")) 
  (setq n 0) 
  (foreach x lst11 
    (command "text" "NON" p1 height "" x) 
    (command) 
    (setq p1 (list (car p1) (- (cadr p1) WBJULI) (caddr p1))) 
    (setq p1 (polar p1 (* pi 1.5) 1)) 
    (setq n (1+ n)) 
  ) 
  (princ) 
)

edata · 发表于 2014-1-7 22:06

要多行就很简单的。。

;; 查找出现次数最多表项】
;; 返回表中出现次数和元素
;; by chlh_jd 发表于 2012-7-18 20:01:02
;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=95639&pid=539700&fromuid=338795
(defun vl-maxtimes (lst / a len ti new)
(while lst
(setq a(car lst)len(length lst)
ti (- len (length (setq lst (vl-remove a lst))))
new (cons (cons ti a) new)))
;(if new(car(vl-sort new (function (lambda (e1 e2) (> (car e1) (car e2)))))))
)
;;;
;;;组码值提取(sk_dxf 图元名组码)
(defun sk_dxf(en code)
(if(and(=(type en) 'ENAME)(= (type code) 'INT))
(cdr(assoc code (entget en))))
)
;;;单行文本重复统计
;;; editor by edata
;;; 2014-1-7 17:43:51
(defun c:tt(/ EN K NEW_LST PT SS STR_LST)
(vl-load-com)
;(or font_heigth (setq font_heigth 300))
(if(setq ss(ssget'((0 . "*text"))))
(progn
(setq str_lst '())
(setq font_heigth(sk_dxf (ssname ss 0) 40));按第选择集的第一个文字字高
(while (setq en(ssname ss 0))
(setq str_lst(cons (sk_dxf en 1)str_lst))
(setq ss(ssdel en ss))
)
(setq str_lst(reverse str_lst))
(setq new_lst(vl-sort (vl-maxtimes str_lst) '(lambda(x1 x2)(< (cdr x1)(cdr x2)) )));按文本内容排序
(if (and (not (null new_lst)) (setq k -1 pt(getpoint "\n指定放置位置点:")))
(foreach n new_lst (entmakex (list
(cons 0 "text")
(cons 10 (polar pt (* pi 1.5) (* (setq k(1+ k)) (* font_heigth 1.5))))
(cons 1 (strcat (rtos (car n) 2 0)" " (cdr n)))
(cons 40 font_heigth)
)
))
)
)
(princ"\n Nothing Select Object!!!")
)
(princ)
)

;; 查找出现次数最多表项】 
;; 返回表中出现次数和元素 
;; by chlh_jd 发表于 2012-7-18 20:01:02 
;;;http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=95639&pid=539700&fromuid=338795 
(defun vl-maxtimes (lst / a len ti new) 
  (while lst 
        (setq a(car lst)len(length lst) 
              ti (- len (length (setq lst (vl-remove a lst)))) 
              new (cons (cons ti a) new))) 
  ;(if new(car(vl-sort new (function (lambda (e1 e2) (> (car e1) (car e2))))))) 
) 
;;; 
;;;组码值提取(sk_dxf 图元名 组码) 
(defun sk_dxf(en code) 
    (if(and(=(type en) 'ENAME)(= (type code) 'INT)) 
      (cdr(assoc code (entget en)))) 
  ) 
;;;单行文本重复统计 
;;; editor by edata 
;;; 2014-1-7 17:43:51 
(defun c:tt(/ EN K NEW_LST PT SS STR_LST) 
  (vl-load-com) 
  ;(or font_heigth (setq font_heigth 300)) 
  (if(setq ss(ssget'((0 . "*text")))) 
    (progn 
      (setq str_lst '()) 
      (setq font_heigth(sk_dxf (ssname ss 0) 40));按第选择集的第一个文字字高 
    (while (setq en(ssname ss 0)) 
      (setq str_lst(cons (sk_dxf en 1)str_lst)) 
      (setq ss(ssdel en ss)) 
      ) 
      (setq str_lst(reverse str_lst)) 
      (setq new_lst(vl-sort (vl-maxtimes str_lst) '(lambda(x1 x2)(< (cdr x1)(cdr x2)) )));按文本内容排序 
      (if (and (not (null new_lst)) (setq  k -1 pt(getpoint "\n指定放置位置点:"))) 
      (foreach n new_lst (entmakex (list 
                                    (cons 0 "text") 
                                    (cons 10 (polar pt (* pi 1.5) (* (setq k(1+ k)) (* font_heigth 1.5)))) 
                                    (cons 1 (strcat (rtos (car n) 2 0)"      " (cdr n))) 
                                    (cons 40 font_heigth) 
                                    ) 
                                  )) 
        )       
    ) 
    (princ"\n Nothing Select Object!!!") 
    ) 
  (princ) 
  )

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

[已解答] 求助lisp 取消重复设定区域问题

本帖子中包含更多资源

点评

本帖子中包含更多资源

1

浏览过的版块