求多个单行文本的对齐程序

LXCH

感觉我要找的程序应该有，但是没有找到。

要对图纸中的多个单行文本进行左对齐，能够调整行间距即可。

要lisp程序，因为还不会用别的程序。

david96007

回楼上的，年代太久远了，代码自己都看不懂了！这个网站自己也有几年没来了，今天是搜索其他资料才回到这里。

ninja37

david96007 发表于 2012-5-4 22:30
回楼上的，年代太久远了，代码自己都看不懂了！这个网站自己也有几年没来了，今天是搜索其他资料才回到这里 ...

岁月流逝了  旧地重游一下

zhuquanmao

 

;平均分布单行文字各行:
(defun c:dqwb ()
(setq a (ssget (list (cons 0 "text"))))
(setq n (sslength a))
(setq all nil)
(setq m 0)
(while (< m n)
(setq all (append all (list (entget (ssname a m)))))
(setq m (1+ m))
)
(setq l 0)
(setq m 1)
(while (< l n)
(setq b (nth l all))
(while (< m n)
(setq c (nth m all))
(if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
(progn
(setq all (subst 'aa (nth l all) all ) )
(setq all (subst 'bb (nth m all) all ) )
(setq all (subst c 'aa all ) )
(setq all (subst b 'bb all ) )
(setq b c)
)
)
(setq m (1+ m))
)
(setq l (1+ l))
(setq m (1+ l))
)
(setq a (nth 0 all))
(setq b (nth (1- n) all))
(setq detay (/ (- (nth 2 (assoc '10 a)) (nth 2 (assoc '10 b))) (1- n) ) )
(setq x0 (nth 1 (assoc '10 a)))
(setq y0 (nth 2 (assoc '10 a)))
(setq m 0)
(while (< m n)
(setq b (nth m all))
(setq x (nth 1 (assoc '10 b)))
(setq y (- y0 (* m detay)))
(setq z (nth 3 (assoc '10 b)))
(setq xyz_new (list '10 x0 y z))
(setq b (subst (cons '72 0) (assoc '72 b) b))
(setq b (subst (cons '73 0) (assoc '73 b) b))
(setq b (subst xyz_new (assoc '10 b) b ) )
(entmod b)
(setq m (1+ m))
)
)

LXCH

谢谢。经试用程序有对齐功能，但是没有调整行距的功能。希望增加自定义行距的功能。

zhuquanmao

你把文本第一行和最后一行的位置确定后，程序会根据这两个位置平均分布行距的。

LXCH

由于不知道行距是多少，不能做到所有图纸中文字间距的统一，所以要自定义行距。

LXCH

对楼上的程序进行了小改动，达到了要求。

(defun c:dqwb ()
(setq a (ssget (list (cons 0 "text"))))
(setq n (sslength a))
(setq all nil)
(setq m 0)
(while (< m n)
(setq all (append all (list (entget (ssname a m)))))
(setq m (1+ m))
)

(setq l 0);;按y坐标降序排列
(setq m 1)
(while (< l n)
(setq b (nth l all))
(while (< m n)
(setq c (nth m all))
(if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
(progn
(setq all (subst 'aa (nth l all) all ) )
(setq all (subst 'bb (nth m all) all ) )
(setq all (subst c 'aa all ) )
(setq all (subst b 'bb all ) )
(setq b c)
)
)
(setq m (1+ m))
)
(setq l (1+ l))
(setq m (1+ l))
)

(setq val (getreal "\n行距："))
(setq p (getpoint "\n首行的插入点："))
(setq x0 (car p))
(setq y0 (cadr p))

(setq m 0)
(while (< m n)
(setq b (nth m all))
(setq y (- y0 (* m val)))
(setq z (nth 3 (assoc '10 b)))
(setq xyz_new (list '10 x0 y z))
(setq b (subst (cons '72 0) (assoc '72 b) b))
(setq b (subst (cons '73 0) (assoc '73 b) b))
(setq b (subst xyz_new (assoc '10 b) b ) )
(entmod b)
(setq m (1+ m))
)
)
(princ "\n＝＝＝对齐单行文本，自定义行距程序成功加载！命令行以dqwb启动！")

gyxzzza

好人真多啊！！

david96007

2. ((defun lconerr (s)
3.   (if (/= s "Function cancelled")
4.     (princ (strcat "\nError: " s))
5.   ) ;_ end of if
6.   (setq text nil)
7.   (setq *error* olderr)
8.   (princ)
9. ) ;_ end of defun
10. (defun getsel ()
11.   (setq sel nil)
12.   (princ "\n请选择要对齐的文字：")
13.   (setq sel (ssget '((0 . "TEXT"))))
14. ) ;_ end of defun
15. (defun C:TA (/ sel e dx dy el de num n x y ty inf olderr ab ac dc db)
16.                                         ;
17.   (setq olderr  *error*
18.         *error* lconerr
19.   ) ;_ end of setq
20.   (initget 128 "M B T L R")
21.   (setq
22.     key (getkword
23.           "\nM左右中对齐/B底对齐/T顶对齐/R右对齐/<L左对齐> "
24.         ) ;_ end of getkword
25.   ) ;_ end of setq
26.   (if (/= key nil)
27.     (setq key (strcase key))
28.   ) ;_ end of if
29. ;;;选择需要对齐的文字
30.   (getsel)
31.   (setq MuBiaoDian (getpoint "\n点取对齐点："))
32. ;;;得到的点是当前坐标系的点
33.   (setq sslen (sslength sel))
34.   (setq test 0)
35.   (while (< test sslen)
36.     (setq TxTEnt (ssname sel test))
37.     (setq TxtD (entget TxtEnt))
38.     (setq GC72 (cdr (assoc 72 TxtD)))
39.     (setq GC73 (cdr (assoc 73 TxtD)))
40.     (if (and (= GC72 0) (= Gc73 0))
41.       (progn
42.         (setq InsP (cdr (assoc 10 TxtD))) ;世界坐标系
43.       ) ;_ end of progn
44.       (progn
45.         (setq InsP (cdr (assoc 11 TxtD))) ;世界坐标系
46.       ) ;_ end of progn
47.     ) ;_ end of if
48.     (setq UInsP (Trans InsP 0 1))       ;转化为当前坐系
49.     (if (or (= key "L")
50.             (= key nil)
51.         ) ;_ end of or
52.       (progn
53.         (ChGC TxTEnt 72 0 ;|nil nil|; 73 0)
54.         (ChC TxtEnt UInsp MuBiaoDian 10 "X")
55.       ) ;_ end of progn
56.       (if (= key "R")
57.         (progn
58.           (ChGC TxTEnt 72 2 nil nil ;|73 0|;)
59.           (ChC TxtEnt UInsp MuBiaoDian 11 "X")
60.         ) ;_ end of progn
61.         (if (= key "T")
62.           (progn
63.             (ChGC TxTEnt ;| 72 1 |; nil nil 73 3)
64.             (ChC TxtEnt UInsp MuBiaoDian 11 "Y")
65.           ) ;_ end of progn
66.           (if (= key "B")
67.             (progn
68.               (ChGC TxTEnt ;| 72 1|; nil nil 73 1)
69.               (ChC TxtEnt UInsp MuBiaoDian 11 "Y")
70.             ) ;_ end of progn
71.             (if (= key "M")
72.               (progn
73.                 (ChGC TxTEnt 72 1 nil nil ;|73 0|;)
74.                 (ChC TxtEnt UInsp MuBiaoDian 11 "X")
75.               ) ;_ end of progn
76.             ) ;_ end of if
77.           ) ;_ end of if
78.         ) ;_ end of if
79.       ) ;_ end of if
80.     ) ;_ end of if
81.     (setq test (1+ test))
82.   ) ;_ end of while
83.   (setq *error* olderr)
84.   (gc)
85.   (princ)
86. ) ;_ end of defun
87. (defun ChGC (TxtEnt GroCod_1 GroCodVal_1 GroCod_2 GroCodVal_2 /)
88.   (setq ED (entget TxtEnt))
89.   (if (/= GroCod_1 nil)
90.     (setq ED (subst (cons GroCod_1 GroCodVal_1) (assoc GroCod_1 ED) ED))
91.   ) ;_ end of if
92.   (if (/= GroCod_2 nil)
93.     (setq ED (subst (cons GroCod_2 GroCodVal_2) (assoc GroCod_2 ED) ED))
94.   ) ;_ end of if
95.   (entmod ED)
96.   (entupd TxtEnt)
97. ) ;_ end of defun
98. (defun ChC (TxTEnt UInp MuBDn GroCod XY /)
99.   (if (= XY "Y")
100.     (setq WInp (trans (list (car UInp)
101.                             (cadr MuBDn)
102.                             (caddr UInp)
103.                       ) ;_ end of list
104.                       1
105.                       0
106.                ) ;_ end of trans
107.     ) ;_ end of setq
108.     (if (= XY "X")
109.       (setq WInp (trans (list (car MuBDn)
110.                               (cadr UInp)
111.                               (caddr UInp)
112.                         ) ;_ end of list
113.                         1
114.                         0
115.                  ) ;_ end of trans
116.       ) ;_ end of setq
117.     ) ;_ end of if
118.   ) ;_ end of setq
119.   (setq NInp (list GroCod
120.                    (car WInp)
121.                    (cadr WInp)
122.                    (caddr WInp)
123.              ) ;_ end of setq
124.   ) ;_ end of setq
125.   (setq TtD (entget TxtEnt))
126.   (setq TtD (subst NInp (assoc GroCod TTD) TTD))
127.   (entmod TtD)
128.   (entupd TxTEnt)
129. ) ;_ end of defun

((defun lconerr (s)   (if (/= s "Function cancelled")     (princ (strcat "\nError: " s))   ) ;_ end of if   (setq text nil)   (setq *error* olderr)   (princ) ) ;_ end of defun (defun getsel ()   (setq sel nil)   (princ "\n请选择要对齐的文字：")   (setq sel (ssget '((0 . "TEXT")))) ) ;_ end of defun (defun C:TA (/ sel e dx dy el de num n x y ty inf olderr ab ac dc db)                                         ;   (setq olderr  *error*         *error* lconerr   ) ;_ end of setq   (initget 128 "M B T L R")   (setq     key (getkword           "\nM左右中对齐/B底对齐/T顶对齐/R右对齐/<L左对齐> "         ) ;_ end of getkword   ) ;_ end of setq   (if (/= key nil)     (setq key (strcase key))   ) ;_ end of if ;;;选择需要对齐的文字   (getsel)   (setq MuBiaoDian (getpoint "\n点取对齐点：")) ;;;得到的点是当前坐标系的点   (setq sslen (sslength sel))   (setq test 0)   (while (< test sslen)     (setq TxTEnt (ssname sel test))     (setq TxtD (entget TxtEnt))     (setq GC72 (cdr (assoc 72 TxtD)))     (setq GC73 (cdr (assoc 73 TxtD)))     (if (and (= GC72 0) (= Gc73 0))       (progn         (setq InsP (cdr (assoc 10 TxtD))) ;世界坐标系       ) ;_ end of progn       (progn         (setq InsP (cdr (assoc 11 TxtD))) ;世界坐标系       ) ;_ end of progn     ) ;_ end of if     (setq UInsP (Trans InsP 0 1))       ;转化为当前坐系     (if (or (= key "L")             (= key nil)         ) ;_ end of or       (progn         (ChGC TxTEnt 72 0 ;|nil nil|; 73 0)         (ChC TxtEnt UInsp MuBiaoDian 10 "X")       ) ;_ end of progn       (if (= key "R")         (progn           (ChGC TxTEnt 72 2 nil nil ;|73 0|;)           (ChC TxtEnt UInsp MuBiaoDian 11 "X")         ) ;_ end of progn         (if (= key "T")           (progn             (ChGC TxTEnt ;| 72 1 |; nil nil 73 3)             (ChC TxtEnt UInsp MuBiaoDian 11 "Y")           ) ;_ end of progn           (if (= key "B")             (progn               (ChGC TxTEnt ;| 72 1|; nil nil 73 1)               (ChC TxtEnt UInsp MuBiaoDian 11 "Y")             ) ;_ end of progn             (if (= key "M")               (progn                 (ChGC TxTEnt 72 1 nil nil ;|73 0|;)                 (ChC TxtEnt UInsp MuBiaoDian 11 "X")               ) ;_ end of progn             ) ;_ end of if           ) ;_ end of if         ) ;_ end of if       ) ;_ end of if     ) ;_ end of if     (setq test (1+ test))   ) ;_ end of while   (setq *error* olderr)   (gc)   (princ) ) ;_ end of defun (defun ChGC (TxtEnt GroCod_1 GroCodVal_1 GroCod_2 GroCodVal_2 /)   (setq ED (entget TxtEnt))   (if (/= GroCod_1 nil)     (setq ED (subst (cons GroCod_1 GroCodVal_1) (assoc GroCod_1 ED) ED))   ) ;_ end of if   (if (/= GroCod_2 nil)     (setq ED (subst (cons GroCod_2 GroCodVal_2) (assoc GroCod_2 ED) ED))   ) ;_ end of if   (entmod ED)   (entupd TxtEnt) ) ;_ end of defun (defun ChC (TxTEnt UInp MuBDn GroCod XY /)   (if (= XY "Y")     (setq WInp (trans (list (car UInp)                             (cadr MuBDn)                             (caddr UInp)                       ) ;_ end of list                       1                       0                ) ;_ end of trans     ) ;_ end of setq     (if (= XY "X")       (setq WInp (trans (list (car MuBDn)                               (cadr UInp)                               (caddr UInp)                         ) ;_ end of list                         1                         0                  ) ;_ end of trans       ) ;_ end of setq     ) ;_ end of if   ) ;_ end of setq   (setq NInp (list GroCod                    (car WInp)                    (cadr WInp)                    (caddr WInp)              ) ;_ end of setq   ) ;_ end of setq   (setq TtD (entget TxtEnt))   (setq TtD (subst NInp (assoc GroCod TTD) TTD))   (entmod TtD)   (entupd TxTEnt) ) ;_ end of defun

8350

怎么会这样

 

命令: _appload 已成功加载   lconerr.lsp。
命令: ; 错误: 输入的列表有缺陷

命令: ta TABLET
定点设备不能用作数字化仪。

GamIng

david96007 发表于 2006-10-21 22:34

8楼程序，如果文字有旋转（角度）程序执行结果是错误的。旋转90°时，文字是叠在一块。