求助lisp 取消重复设定区域问题
本帖最后由 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 0stxt "")
(command "text" spt1 1000 0(sslength ss) "")
(setq sspt (polar sspt (- (/ pi 2)) 1500))
))
)
(princ "\n")
(setvar "CMDECHO" 1)
(princ)
)
恩，图中无窗图块，就窗号字符串就行，求大侠解决感激不尽啊 大侠快出现啊 对楼主的帖子标题表达感觉无语。。。
楼主估计要的是批量统计文本，并标示数量。
估计结果如下图：
edata 发表于 2014-1-7 15:06 static/image/common/back.gif
对楼主的帖子标题表达感觉无语。。。
楼主估计要的是批量统计文本，并标示数量。
估计结果如下图：
对的，大侠终于出现了，就是大侠你说的这个意思，如何实现批量统计文本，并标示数量 ;; 查找出现次数最多表项】
;; 返回表中出现次数和元素
;; 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)) (setqk -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)
) edata 发表于 2014-1-7 17:44 static/image/common/back.gif
在网上找了个更便捷的代码，更有效些，但是缺点是需要单行文字，另外生成的文字重叠，大侠看看能解决重叠问题不
(defun c:wba (/ LST1 N E S WB SSlst2
lst_new shuz lst lst11lst12 heightp1
WBJULI
)
(setqss (ssget '((0 . "TEXT")))
N0
)
(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)
)
1
本帖最后由 jly0406 于 2014-1-7 19:48 编辑怎么能解决重叠问题呢 jly0406 发表于 2014-1-7 19:42 static/image/common/back.gif
怎么能解决重叠问题呢
----------------------------- 表示无语----------------------------------------(defun c:wba (/ LST1 N E S WB SSlst2
lst_new shuz lst lst11lst12 heightp1
WBJULI
)
(setqss (ssget '((0 . "TEXT")))
N0
)
(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)
) 要多行就很简单的。。;; 查找出现次数最多表项】
;; 返回表中出现次数和元素
;; 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)) (setqk -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)
)
页:
[1]
2