列表显示文字
(princ "\n文字列表显示,命令TT:\n")
(defun c:tt (/ )
;;文字列表
;;20160122wkq004
(while (not
(setq e (car (entsel "\n选择要列表显示的文字所在的图层:")))
)
)
(setq lst '())
(if (setq
ss (ssget
"x"
(list (cons 0 "TEXT") (cons 8 (cdr (assoc 8 (entget e)))))
)
)
(progn
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq str (cdr (assoc 1 (entget e))))
(if (not (member str lst))
(setq lst (cons str lst))
)
)
(princ "\n拾取定位点,表格左上角-->>")
;;;
(setq n (length lst))
(setq strNum "")
(setq h 2.0)
(setq xh t)
(while xh
(setq tmp (grread t 15 1))
(setq mode (car tmp))
(setq val (cadr tmp))
(redraw)
(cond
((= mode 5)
(setq
a (* h 5 3)
b (* (* h 1.5) n)
)
(setq pt1 val
pt2 (mapcar '+ val (list a 0))
pt3 (mapcar '+ val (list a (- b)))
pt4 (mapcar '+ val (list 0 (- b)))
)
(grdraw pt1 pt2 1)
(grdraw pt2 pt3 1)
(grdraw pt3 pt4 1)
(grdraw pt4 pt1 1)
(setq aa
(* 20 (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
)
(setq pt1 (mapcar '- val (list aa aa)))
(setq pt3 (mapcar '+ val (list aa aa)))
(setq pt2 (mapcar '+ val (list aa (- aa))))
(setq pt4 (mapcar '+ val (list (- aa) aa)))
(grdraw pt1 pt3 3)
(grdraw pt4 pt2 3)
)
((= mode 3)
(setq pt val)
(princ "\n输入字高默认<2.0>或点取两点指定列表长:")
(setq xh2 t)
(while xh2
(setq tmp (grread t 15 1))
(setq mode2 (car tmp))
(setq val2 (cadr tmp))
(redraw)
(cond
((= mode2 5)
(setq val2 (list (car val) (cadr val2)))
(setq dist (distance val val2))
(setq hh (/ dist (length lst)))
(setq
a (* hh 5 3)
b (* (* hh 1.5) n)
)
(setq pt1 val
pt2 (mapcar '+ val (list a 0))
pt3 (mapcar '+ val (list a (- b)))
pt4 (mapcar '+ val (list 0 (- b)))
)
(grdraw pt1 pt2 1)
(grdraw pt2 pt3 1)
(grdraw pt3 pt4 1)
(grdraw pt4 pt1 1)
)
((= mode2 3)
(setq h hh)
(princ "\n表格高度:")
(princ dist)
(princ " 字高:")
(princ h)
(princ "")
(setq xh2 nil)
(setq xh nil)
)
((and (= mode2 2) (<= 48 val2 57))
(princ (chr val2))
(setq strNum (strcat strNum (chr val2)))
(setq h 2.0)
(setq a (* h 5)
b (* (* h 1.5) (length lst))
)
)
((and (= mode2 2) (= 8 val2))
(setq strNum (substr strNum 1 (1- (strlen strNum))))
(princ "\n字高:")
(princ strNum)
)
((and (= mode2 2) (or (= 13 val2) (= 32 val2)))
(if (distof strNum)
(setq h (atoi strNum))
(setq h 2.0)
)
(setq xh2 nil)
(setq xh nil)
)
((= mode 25)
(if (distof strNum)
(setq h (atoi strNum))
(setq h 2.0)
)
(setq xh2 nil)
(setq xh nil)
)
(t
(princ "\n")
(princ mode)
(princ " ")
(princ val)
(princ "\n")
)
)
)
)
)
)
;;; (setq tmp (getvar "lastpoint"))
;;; (if (and (setq
;;; h (getdist "\n输入字高默认<2.0>或点取两点指定列表长:")
;;; )
;;; (not (equal tmp (getvar "lastpoint")))
;;; )
;;;(progn
;;; ;;列表长
;;; (setq h (/ h (length lst)))
;;; (princ "\n字高:")
;;; (princ h)
;;;)
;;;(if h
;;; ;;输入了字高
;;; (progn (princ "\n字高:")
;;; (princ h)
;;; )
;;; ;;未输入距离或用鼠标拾取距离,但仅点取了一点
;;; (setq h 2.0)
;;;)
;;; )
;;; (if (and (not pt)
;;; (not (setq pt (getpoint "\n点取放置列表的左上角:")))
;;; )
;;;(progn
;;; (command "zoom" "e")
;;; ;;117.3 [功能] 返回当前视窗左下角和右上角 坐标
;;; (setqb (getvar "viewsize")
;;; c (car (getvar "screensize"))
;;; d (cadr (getvar "screensize"))
;;; a (* b (/ c d))
;;; x (setq x (getvar "viewctr"))
;;; x (trans x 1 2)
;;; c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
;;; d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
;;; c (trans c 2 1)
;;; d (trans d 2 1)
;;; )
;;; (setq zoom t)
;;; (setq pt d)
;;;)
;;; )
(setq lst (vl-sort lst '<))
(setq i -1)
(setq a (car pt))
(setq b (+ a (* h 5 3)))
(entmake
(list
(cons 0 "LINE")
(cons 8 "表格")
(cons 62 256)
(list10
a
(setq y (- (cadr pt) (* (setq i (1+ i)) (* h 1.5))))
)
(list 11 b y)
)
)
(repeat (length lst)
(entmake
(list
(cons 0 "LINE")
(cons 8 "表格")
(cons 62 256)
(list 10
a
(setq y (- (cadr pt) (* (setq i (1+ i)) (* h 1.5))))
)
(list 11 b y)
)
)
(entmake
(list
(cons 0 "TEXT")
(cons 8 "表格")
(cons 62 256)
(cons 1 (itoa i))
(cons 40 h)
(list 10
(+ a (* h 5 0.5))
(+ y (* h 1.5 0.5))
)
(list 11
(+ a (* h 5 0.5))
(+ y (* h 1.5 0.5))
)
(cons 72 1)
(cons 73 2)
)
)
(entmake
(list
(cons 0 "TEXT")
(cons 8 "表格")
(cons 62 256)
(cons 1 (nth (1- i) lst))
(cons 40 h)
(list 10
(+ a (* h 5 0.5 3))
(+ y (* h 1.5 0.5))
)
(list 11
(+ a (* h 5 0.5 3))
(+ y (* h 1.5 0.5))
)
(cons 72 1)
(cons 73 2)
)
)
)
(setq i -1)
(setq a (cadr pt))
(setq b (- a (* (length lst) (* h 1.5))))
(repeat 4
(entmake
(list(cons 0 "LINE")
(cons 8 "表格")
(cons 62 256)
(list 10
(setq x (+ (car pt) (* (setq i (1+ i)) (* h 5))))
a
)
(list 11 x b)
)
)
)
)
(princ "\n在选定的图层未找到文字.")
)
(princ "\n完成")
;;;(and zoom (command "zoom" "e"))
(princ)
)
664571221 发表于 2018-9-25 20:12
能否加一个范围选择
范围选择,能下源码的都会改,个数统计已经有计数了. wkq004 发表于 2016-1-24 23:06
能否加一个范围选择 试用了一下，很不错。把TEXT改为*TEXT可统计多行文字。能不能加一项统计数量？
(princ "\n文字列表显示,命令TT:\n")
(defun c:tt (/ delSS)
;;文字列表
;;20160122wkq004
(while (not
(setq e (car (entsel "\n选择要列表显示的文字所在的图层:")))
)
)
(setq lst '())
(if (setq
ss (ssget
"x"
(list (cons 0 "TEXT") (cons 8 (cdr (assoc 8 (entget e)))))
)
)
(progn
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq str (cdr (assoc 1 (entget e))))
(if (not (member str lst))
(setq lst (cons str lst))
)
)
(princ "\n拾取表格角点-->>")
(setq n (length lst))
(setq numLst '())
(setq strNum "")
(setq h 2.0)
(setq go t)
(while go
(setq tmp (grread t 15 1))
(setq mode (car tmp))
(setq val (cadr tmp))
(redraw)
(cond
((= mode 5)
(setq
a (* (/ h 1.5) 5 3)
b (* h n)
)
(setq zspt (mapcar '+ val (list (- a) b)))
(FUNredraw zspt a b)
(FUNredrawMouse zspt)
)
((= mode 3)
(setq pto zspt)
(princ "\n输入行高如<2.0>或点取两点指定列表长:")
(setq go2 t)
(while go2
(setq tmp (grread t 15 1))
(setq mode2 (car tmp))
(setq val2 (cadr tmp))
(redraw)
(cond
((= mode2 5)
(setq h
(/ (abs (- (cadr pto) (cadr val2))) (length lst))
)
(setq
a (* (/ h 1.5) 5 3)
b (* h n)
)
(setq tmp (FUNxiangXian pto val2))
(FUNredraw
(setq
pt
(mapcar '+
pto
(list (* a (car tmp)) (* b (cadr tmp)))
)
)
a
b
)
(FUNredrawMouse val2)
)
((= mode2 3)
(setq go2 nil)
(setq go nil)
)
((and (= mode2 2) (<= 46 val2 57) (/= 47 val2))
;;46小数点,47"/"(ascii ".")46(chr 47)"/"
(setq tmp (FUNinputReal
"行高:"
"输入行高如<2.0>或点取两点指定列表长:"
(list val2)
pto
n
)
)
(if tmp
(setq
pt (cadr tmp)
h (car tmp)
a (* (/ h 1.5) 5 3)
b (* h n)
go2 nil
go nil
)
(setq h 2.0)
)
)
((= mode2 25)
(setq lst nil)
(setq go2 nil)
(setq go nil)
)
)
)
)
((= mode 25)
(setq lst nil)
(setq go nil)
)
)
)
(if lst
(progn
(setq lst (vl-sort lst '<))
(FUNtable pt n 3 a b nil "表格")
(princ "\n完成")
)
(princ "\n放弃")
)
(redraw)
)
(princ "\n在选定的图层未找到文字.")
)
(princ)
)
(defun FUNtableText (lst pt row column aa bb cell lay /)
(setq i 0)
(repeat row
(entmake
(list
(cons 0 "TEXT")
(cons 8 lay)
(cons 62 256)
(cons 1 (itoa (1+ i)))
(cons 40 (/ h 1.5))
(cons 10
(setq
tmp
(list (+ x (* w 0.5))
(setq yy (- y (* (setq i (1+ i)) h) (* h -0.5)))
)
)
)
(cons 11 tmp)
(cons 72 1)
(cons 73 2)
)
)
(entmake
(list
(cons 0 "TEXT")
(cons 8 lay)
(cons 62 256)
(cons 1 (nth (1- i) lst))
(cons 40 h)
(cons 40 (/ h 1.5))
(cons 10
(setq tmp (list (+ x (* w 1.5))
yy
)
)
)
(cons 11 tmp)
(cons 72 1)
(cons 73 2)
)
)
)
)
(defun FUNxiangXian (pto pt / ang a b)
;;以pto为参照原点,返回pt所在的象限,及以pto在左上角时符号是正为参照,将pto改成左上角时xy的改正值
(setq ang (angle pto pt))
(cond
((<= 0 ang (/ pi 2))
(setq
a 0
b 1
c 1
)
) ;_1象限
((<= (/ pi 2) ang pi)
(setq
a -1
b 1
c 2
)
) ;_2象限
((<= pi ang (* pi 1.5))
(setq
a -1
b 0
c 3
)
) ;_3象限
((<= (* pi 1.5) ang (* pi 2))
(setq
a 0
b 0
c 4
)
) ;_4象限
)
(list a b c)
)
(defun FUNtable (pt row column aa bb cell lay /)
;;绘制直线表格
(progn
(if cell
(setq w (abs aa)
h (abs bb)
a (* w column)
b (* h row)
)
(setq a (abs aa)
b (abs bb)
w (/ a column)
h (/ b row)
)
)
(setq x (car pt))
(setq y (cadr pt))
(cond ((and (> aa 0) (< bb 0)) ;_1象限
(setq pt (list x (+ y b)))
)
((and (< aa 0) (< bb 0)) ;_2象限
(setq pt (list (- x a) (+ y b)))
)
((and (< aa 0) (> bb 0)) ;_3象限
(setq pt (list (- x a) y))
)
((and (> aa 0) (> bb 0)) ;_4象限
(setq pt pt)
)
)
(setq x (car pt))
(setq y (cadr pt))
(setq xx (+ x a))
(setq i -1)
(repeat (1+ row)
(entmake
(list
(cons 0 "LINE")
(cons 8 lay)
(cons 62 256)
(list 10
x
(setq yy (- y (* (setq i (1+ i)) h)))
)
(list 11 xx yy)
)
)
)
(setq i 0)
(repeat row
(entmake
(list
(cons 0 "TEXT")
(cons 8 lay)
(cons 62 256)
(cons 1 (itoa (1+ i)))
(cons 40 (/ h 1.5))
(cons 10
(setq
tmp
(list (+ x (* w 0.5))
(setq yy (- y (* (setq i (1+ i)) h) (* h -0.5)))
)
)
)
(cons 11 tmp)
(cons 72 1)
(cons 73 2)
)
)
(entmake
(list
(cons 0 "TEXT")
(cons 8 lay)
(cons 62 256)
(cons 1 (nth (1- i) lst))
(cons 40 h)
(cons 40 (/ h 1.5))
(cons 10
(setq tmp (list (+ x (* w 1.5))
yy
)
)
)
(cons 11 tmp)
(cons 72 1)
(cons 73 2)
)
)
)
(setq i -1)
(setq yy (- y b))
(repeat (1+ column)
(entmake
(list
(cons 0 "LINE")
(cons 8 lay)
(cons 62 256)
(list 10
(setq xx (+ x (* (setq i (1+ i)) w)))
y
)
(list 11 xx yy)
)
)
)
)
)
(defun FUNinputReal (strrestr lst pton / A AA B
GO H MODE PT1 PT2PT3PT4 REAL TMPVAL
ptxx
)
;;输入实数20081128zml84
;;http://bbs.mjtd.com/thread-72167-1-1.html
(vl-load-com)
(setvar "CMDECHO" 0)
(princ "\n")
(princ (strcat "\r" str))
(princ (vl-list->string (reverse lst)))
(defun FUNtmp ()
;;
(setq h (read (vl-list->string (reverse lst))))
(setq
a (* (/ h 1.5) 5 3)
b (* h n)
)
(setq ptxx (FUNxiangXian pto pt2))
(FunRedrawRectang
(setq
pt
(mapcar '+
pto
(list (* a (car ptxx)) (* b (cadr ptxx)))
)
)
a
b
)
(FUNredrawMouse pt2)
;;; (FUNredrawMouse (mapcar '+ pt (list a (- b))))
)
;;;(if lst
;;; (progn
;;; (princ (vl-list->string (reverse lst)))
;;; (setq val (cadr (grread t 1 1)))
;;; (FUNtmp)
;;; )
;;;)
(setq real nil)
(setq window (getvar "VIEWSIZE"))
(setq go T)
(while go
(setq tmp(grread t 15 1)
mode (car tmp)
val(cadr tmp)
)
(redraw)
(cond ((and (= mode 5)
(setq pt2 val)
(or
(FUNredrawMouse pt2)
(not (equal ptxx (setq ptxx (FUNxiangXian pto pt2))))
(not (equal window (setq window (getvar "VIEWSIZE"))))
)
)
(FUNtmp)
)
((and (= mode 2)
(/= val 47)
(<= 46 val 57)
)
(setq lst (cons val lst))
(princ (strcat "\r"
str
(vl-list->string (reverse lst))
" "
)
)
(FUNtmp)
)
((or
(and (= mode 2)
(or (= val 13) ;_回车键
(= val 32) ;_空格
)
)
(= mode 3) ;_左键
)
(if lst
(progn
(setq real (read (vl-list->string (reverse lst))))
;;; (princ (strcat "\n" str (vl-list->string (reverse lst))))
(setq lst '())
)
)
(setq go nil)
)
((and (= mode 2)
(= val 8) ;_退格键
)
(setq lst (cdr lst))
(princ (strcat "\r"
str
(vl-list->string (reverse lst))
" "
)
)
(if lst
(FUNtmp)
(progn
(princ "\n")
(princ restr)
(setq go nil)
)
)
)
((= mode 25)
(princ "\n")
(princ restr)
(setq go nil)
)
)
)
(if (and delSS (> (setq n (sslength delSS)) 0))
;;; (command "erase" delSS "")
(progn (repeat n
(if (not (vlax-erased-p
(vlax-ename->vla-object
(setq tmp (ssname delSS (setq n (1- n))))
)
)
)
(entdel tmp)
)
)
(setq
delSS (ssadd)
)
)
(setq delSS (ssadd))
)
(if real
(list real pt)
nil
)
)
(defun FunRedrawRectang (pt a b / n A B tmp PT1 PT2 PT3 PT4)
;;以左上角为基点绘制矩形
(if (and delSS (> (setq n (sslength delSS)) 0))
;;; (command "erase" delSS "")
(progn (repeat n
(if (not (vlax-erased-p
(vlax-ename->vla-object
(setq tmp (ssname delSS (setq n (1- n))))
)
)
)
(entdel tmp)
)
)
(setq delSS (ssadd))
)
(setq delSS (ssadd))
)
(setq pt1 pt
pt2 (mapcar '+ pt (list a 0))
pt3 (mapcar '+ pt (list a (- b)))
pt4 (mapcar '+ pt (list 0 (- b)))
)
(ssadd (FunEntmakeLine pt1 pt2 "外框") delSS)
(ssadd (FunEntmakeLine pt2 pt3 "外框") delSS)
(ssadd (FunEntmakeLine pt3 pt4 "外框") delSS)
(ssadd (FunEntmakeLine pt4 pt1 "外框") delSS)
)
(defun FunEntmakeLine (a b lay /)
(if (entmake
(list (cons 0 "LINE")
(cons 8 lay)
(cons 62 1)
(cons 10 a)
(cons 11 b)
)
)
(entlast)
nil
)
)
(defun FUNredraw (pt a b / A B tmp PT1 PT2 PT3 PT4)
;;以左上角为基点绘制矩形
(redraw)
(setq pt1 pt
pt2 (mapcar '+ pt (list a 0))
pt3 (mapcar '+ pt (list a (- b)))
pt4 (mapcar '+ pt (list 0 (- b)))
)
(grdraw pt1 pt2 1)
(grdraw pt2 pt3 1)
(grdraw pt3 pt4 1)
(grdraw pt4 pt1 1)
)
(defun FUNredrawMouse (pt / A B tmp PT1 PT2 PT3 PT4)
(setq tmp
(* 20 (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
)
(setq pt1 (mapcar '- pt (list tmp tmp)))
(setq pt3 (mapcar '+ pt (list tmp tmp)))
(setq pt2 (mapcar '+ pt (list tmp (- tmp))))
(setq pt4 (mapcar '+ pt (list (- tmp) tmp)))
(grdraw pt1 pt3 3)
(grdraw pt4 pt2 3)
) 建议文字之间连线，容易查找 非常实用的程序，谢谢楼主分享。 你好能否价格个数统计和范围选择 感谢楼主分享 感谢楼主分享
页:
[1]
2