仿JUSTIFYTEXT

自贡黄明儒

;;BCAD没有JUSTIFYTEXT，仿AutoCAD写一个

;; [功能] 获取两点的中点坐标
(defun MJ:MIDPOINT (P1 P2)
  (mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2)
)

1. (defun C:t1 (/ KEY SS)
   
2.   (setq ss (ssget '((0 . "TEXT"))))
   
3.   (initget "L A F C M R TL TC TR ML MC MR BL BC BR ")
   
4.   (setq        key
   
5.          (getkword
   
6.            "\n[左对齐(L)/对齐(A)/布满(F)/居中(C)/中间(M)/右对齐(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <正中(MC)>:"
   
7.          )
   
8.   )
   
9.   (if (not key)
   
10.     (setq key "MC")
    
11.   )
    
12.   (MY-JUSTIFYTEXT ss key)
    
13.   (princ)
    
14. )
    
15. 
    
16. (DEFUN MY-JUSTIFYTEXT(ss key / E EN N P P10 PTS)
    
17.   (repeat (setq n (sslength ss))
    
18.     (setq e (ssname ss (setq n (1- n))))
    
19.     (setq en (entget e))
    
20.     (setq p10(cdr (assoc 10 en)))
    
21.     (setq pts (textbox en))
    
22.     (setq p (apply 'MJ:MIDPOINT pts))
    
23.     (cond
    
24.       ((= key "L");左对齐
    
25.        (entmod (append en
    
26.                        (list (cons 10 p10)
    
27.                              '(71 . 0)
    
28.                              '(72 . 0)
    
29.                              '(11 0 0)
    
30.                              '(73 . 0)
    
31.                        )
    
32.                )
    
33.        )
    
34.       )
    
35.       ((= key "A");/对齐
    
36.        (entmod (append en
    
37.                          (list (cons 10 p10)
    
38.                                '(71 . 0)
    
39.                                '(72 . 3)
    
40.                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))
    
41.                                '(73 . 0)
    
42.                          )
    
43.                  )
    
44.          )
    
45.       )
    
46.       ((= key "F");/布满
    
47.        (entmod (append en
    
48.                          (list (cons 10 p10)
    
49.                                '(71 . 0)
    
50.                                '(72 . 5)
    
51.                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))
    
52.                                '(73 . 0)
    
53.                          )
    
54.                  )
    
55.          )
    
56.       )
    
57.       ((= key "C");居中
    
58.        (entmod (append en
    
59.                          (list (cons 10 p10)
    
60.                                '(71 . 0)
    
61.                                '(72 . 1)
    
62.                                (list 11 (+ (car p10) (car p)) (cadr p10))
    
63.                                '(73 . 0)
    
64.                          )
    
65.                  )
    
66.          )
    
67.       )
    
68.       ((= key "M");/中间
    
69.        (entmod (append en
    
70.                        (list (cons 10 p10)
    
71.                              '(71 . 0)
    
72.                              '(72 . 4)
    
73.                              (cons 11 (mapcar '+ p p10))
    
74.                              '(73 . 0)
    
75.                        )
    
76.                )
    
77.        )
    
78.       )
    
79.       ((= key "R");右对齐(R)
    
80.        (entmod (append en
    
81.                          (list (cons 10 p10)
    
82.                                '(71 . 0)
    
83.                                '(72 . 2)
    
84.                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))
    
85.                                '(73 . 0)
    
86.                          )
    
87.                  )
    
88.          )
    
89.       )
    
90.       ((= key "TL");/左上
    
91.        (entmod (append en
    
92.                        (list (cons 10 p10)
    
93.                              '(71 . 0)
    
94.                              '(72 . 0)
    
95.                              (list 11 (car p10) (+ (cadr p10) (cadadr pts)))
    
96.                              '(73 . 3)
    
97.                        )
    
98.                )
    
99.        )
    
100.       )
     
101.       ((= key "TC");/中上
     
102.        (entmod (append en
     
103.                        (list (cons 10 p10)
     
104.                              '(71 . 0)
     
105.                              '(72 . 1)
     
106.                              (list 11 (+ (car p10) (car p)) (+ (cadr p10) (cadadr pts)))
     
107.                              '(73 . 3)
     
108.                        )
     
109.                )
     
110.        )
     
111.       )
     
112.       ((= key "TR");/右上
     
113.        (entmod (append en
     
114.                        (list (cons 10 p10)
     
115.                              '(71 . 0)
     
116.                              '(72 . 2)
     
117.                              (list 11 (+ (car p10) (caadr pts)) (+ (cadr p10) (cadadr pts)))
     
118.                              '(73 . 3)
     
119.                        )
     
120.                )
     
121.        )
     
122.       )
     
123.       ((= key "ML");/左中
     
124.        (entmod (append en
     
125.                        (list (cons 10 p10)
     
126.                              '(71 . 0)
     
127.                              '(72 . 0)
     
128.                              (list 11 (car p10) (+ (cadr p10) (cadr p)))
     
129.                              '(73 . 2)
     
130.                        )
     
131.                )
     
132.        )
     
133.       )
     
134.       ((= key "MC");/正中
     
135.        (entmod (append en
     
136.                        (list (cons 10 p10)
     
137.                              '(71 . 0)
     
138.                              '(72 . 1)
     
139.                              (cons 11 (mapcar '+ p10 p))
     
140.                              '(73 . 2)
     
141.                        )
     
142.                )
     
143.        )
     
144.       )
     
145.       ((= key "MR");/右中
     
146.        (entmod (append en
     
147.                        (list (cons 10 p10)
     
148.                              '(71 . 0)
     
149.                              '(72 . 2)
     
150.                              (list 11 (+ (car p10) (caadr pts)) (+ (cadr p10) (cadr p)))
     
151.                              '(73 . 2)
     
152.                        )
     
153.                )
     
154.        )
     
155.       )
     
156.       ((= key "BL");/左下
     
157.        (entmod (append en
     
158.                        (list (cons 10 p10)
     
159.                              '(71 . 0)
     
160.                              '(72 . 0)
     
161.                              (cons 11 p10)
     
162.                              '(73 . 1)
     
163.                        )
     
164.                )
     
165.        )
     
166.       )
     
167.       ((= key "BC");/中下
     
168.        (entmod (append en
     
169.                        (list (cons 10 p10)
     
170.                              '(71 . 0)
     
171.                              '(72 . 1)
     
172.                              (list 11 (+ (car p10) (car p)) (cadr p10))
     
173.                              '(73 . 1)
     
174.                        )
     
175.                )
     
176.        )
     
177.       )
     
178.       ((= key "BR");右下
     
179.        (entmod (append en
     
180.                        (list (cons 10 p10)
     
181.                              '(71 . 0)
     
182.                              '(72 . 2)
     
183.                              (list 11 (+ (car p10) (caadr pts)) (cadr p10))
     
184.                              '(73 . 1)
     
185.                        )
     
186.                )
     
187.        )
     
188.       )
     
189.     )
     
190.   )
     
191. )
     
192. 
     

(defun C:t1 (/ KEY SS)<br />   (setq ss (ssget '((0 . "TEXT"))))<br />   (initget "L A F C M R TL TC TR ML MC MR BL BC BR ")<br />   (setq        key<br />          (getkword<br />            "\n[左对齐(L)/对齐(A)/布满(F)/居中(C)/中间(M)/右对齐(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <正中(MC)>:"<br />          )<br />   )<br />   (if (not key)<br />     (setq key "MC")<br />   )<br />   (MY-JUSTIFYTEXT ss key)<br />   (princ)<br /> )<br /> <br /> (DEFUN MY-JUSTIFYTEXT(ss key / E EN N P P10 PTS)<br />   (repeat (setq n (sslength ss))<br />     (setq e (ssname ss (setq n (1- n))))<br />     (setq en (entget e))<br />     (setq p10(cdr (assoc 10 en)))<br />     (setq pts (textbox en))<br />     (setq p (apply 'MJ:MIDPOINT pts))<br />     (cond<br />       ((= key "L");左对齐<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 0)<br />                              '(11 0 0)<br />                              '(73 . 0)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "A");/对齐<br />        (entmod (append en<br />                          (list (cons 10 p10)<br />                                '(71 . 0)<br />                                '(72 . 3)<br />                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))<br />                                '(73 . 0)<br />                          )<br />                  )<br />          )<br />       )<br />       ((= key "F");/布满<br />        (entmod (append en<br />                          (list (cons 10 p10)<br />                                '(71 . 0)<br />                                '(72 . 5)<br />                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))<br />                                '(73 . 0)<br />                          )<br />                  )<br />          )<br />       )<br />       ((= key "C");居中<br />        (entmod (append en<br />                          (list (cons 10 p10)<br />                                '(71 . 0)<br />                                '(72 . 1)<br />                                (list 11 (+ (car p10) (car p)) (cadr p10))<br />                                '(73 . 0)<br />                          )<br />                  )<br />          )<br />       )<br />       ((= key "M");/中间<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 4)<br />                              (cons 11 (mapcar '+ p p10))<br />                              '(73 . 0)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "R");右对齐(R)<br />        (entmod (append en<br />                          (list (cons 10 p10)<br />                                '(71 . 0)<br />                                '(72 . 2)<br />                                (list 11 (+ (car p10) (caadr pts)) (cadr p10))<br />                                '(73 . 0)<br />                          )<br />                  )<br />          )<br />       )<br />       ((= key "TL");/左上<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 0)<br />                              (list 11 (car p10) (+ (cadr p10) (cadadr pts)))<br />                              '(73 . 3)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "TC");/中上<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 1)<br />                              (list 11 (+ (car p10) (car p)) (+ (cadr p10) (cadadr pts)))<br />                              '(73 . 3)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "TR");/右上<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 2)<br />                              (list 11 (+ (car p10) (caadr pts)) (+ (cadr p10) (cadadr pts)))<br />                              '(73 . 3)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "ML");/左中<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 0)<br />                              (list 11 (car p10) (+ (cadr p10) (cadr p)))<br />                              '(73 . 2)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "MC");/正中<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 1)<br />                              (cons 11 (mapcar '+ p10 p))<br />                              '(73 . 2)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "MR");/右中<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 2)<br />                              (list 11 (+ (car p10) (caadr pts)) (+ (cadr p10) (cadr p)))<br />                              '(73 . 2)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "BL");/左下<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 0)<br />                              (cons 11 p10)<br />                              '(73 . 1)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "BC");/中下<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 1)<br />                              (list 11 (+ (car p10) (car p)) (cadr p10))<br />                              '(73 . 1)<br />                        )<br />                )<br />        )<br />       )<br />       ((= key "BR");右下<br />        (entmod (append en<br />                        (list (cons 10 p10)<br />                              '(71 . 0)<br />                              '(72 . 2)<br />                              (list 11 (+ (car p10) (caadr pts)) (cadr p10))<br />                              '(73 . 1)<br />                        )<br />                )<br />        )<br />       )<br />     )<br />   )<br /> )<br /> <br />

自贡黄明儒

根据老迈建议，文字修改后移回原来的基点，这样看起来文字 就不动了
;;BCAD没有JUSTIFYTEXT，仿autocad写一个
(defun C:JUSTIFYTEXT (/ E KEY N OBJ P1 P2 SS)
  (setq ss (ssget '((0 . "TEXT"))))
  (initget "L A F C M R TL TC TR ML MC MR BL BC BR ")
  (setq        key
         (getkword
           "\n[左对齐(L)/对齐(A)/布满(F)/居中(C)/中间(M)/右对齐(R)/左上(TL)/中上(TC)/右上(TR)/左中(ML)/正中(MC)/右中(MR)/左下(BL)/中下(BC)/右下(BR)] <正中(MC)>:"
         )
  )
  (if (not key)
    (setq key "MC")
  )
  (repeat (setq n (sslength ss))
    (setq e (ssname ss (setq n (1- n))))
    (setq obj (vlax-ename->vla-object e))
    ;;(vla-getboundingbox e 'bp 'up)
    ;;(setq p1 (Entity:Box e))
    (setq p1 (vlax-get obj 'InsertionPoint))
    (MY-JUSTIFYTEXT e key)
    ;;(setq p2 (Entity:Box e))
    (setq p2 (vlax-get obj 'InsertionPoint))
    (vla-move obj (vlax-3D-point p2) (vlax-3D-point p1))
  )
  (princ)
)
;;bcad不能像acad增加表来更新，必须用subst
(DEFUN MY-JUSTIFYTEXT (e key / EN P P10 PTS)
  (setq en (entget e))
  (setq p10 (cdr (assoc 10 en)))
  (setq pts (textbox en))
  (setq p (apply 'MJ:MIDPOINT pts))
  (cond
    ((= key "L")                        ;左对齐
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 0)(assoc 72 en) en))
     (setq en (subst '(11 0 0)(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))     
    )
    ((= key "A")                        ;/对齐
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 3)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (caadr pts)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))
    )
    ((= key "F")                        ;/布满
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 5)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (caadr pts)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))
    )
    ((= key "C")                        ;居中
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 1)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (car p)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))
    )
    ((= key "M")                        ;/中间
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 4)(assoc 72 en) en))
     (setq en (subst (cons 11 (mapcar '+ p p10))(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))     
    )
    ((= key "R")                        ;右对齐(R)
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 2)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (caadr pts)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 0)(assoc 73 en) en))
    )
    ((= key "TL")                        ;/左上
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 0)(assoc 72 en) en))
     (setq en (subst (list 11 (car p10) (+ (cadr p10) (cadadr pts)))(assoc 11 en) en))
     (entmod (subst '(73 . 3)(assoc 73 en) en))
    )
    ((= key "TC")                        ;/中上
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 1)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (car p)) (+ (cadr p10) (cadadr pts)))(assoc 11 en) en))
     (entmod (subst '(73 . 3)(assoc 73 en) en))
    )
    ((= key "TR")                        ;/右上
      (setq en (subst (cons 10 p10) (assoc 10 en) en))
      (setq en (subst '(71 . 0) (assoc 71 en) en))
      (setq en (subst '(72 . 2) (assoc 72 en) en))
      (setq en (subst (list 11
                            (+ (car p10) (caadr pts))
                            (+ (cadr p10) (cadadr pts))
                      )
                      (assoc 11 en)
                      en
               )
      )
      (entmod (subst '(73 . 3) (assoc 73 en) en))
    )
    ((= key "ML")                        ;/左中
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 0)(assoc 72 en) en))
     (setq en (subst (list 11 (car p10) (+ (cadr p10) (cadr p)))(assoc 11 en) en))
     (entmod (subst '(73 . 2)(assoc 73 en) en))
    )
    ((= key "MC")                        ;/正中
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 1)(assoc 72 en) en))
     (setq en (subst (cons 11 (mapcar '+ p10 p))(assoc 11 en) en))
     (entmod (subst '(73 . 2)(assoc 73 en) en))
    )
    ((= key "MR")                        ;/右中
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 2)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (caadr pts)) (+ (cadr p10) (cadr p)))(assoc 11 en) en))
     (entmod (subst '(73 . 2)(assoc 73 en) en))
    )
    ((= key "BL")                        ;/左下
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 0)(assoc 72 en) en))
     (setq en (subst (cons 11 p10)(assoc 11 en) en))
     (entmod (subst '(73 . 1)(assoc 73 en) en))
    )
    ((= key "BC")                        ;/中下
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 1)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (car p)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 1)(assoc 73 en) en))
    )
    ((= key "BR")                        ;右下
     (setq en (subst (cons 10 p10)(assoc 10 en) en))
     (setq en (subst '(71 . 0)(assoc 71 en) en))
     (setq en (subst '(72 . 2)(assoc 72 en) en))
     (setq en (subst (list 11 (+ (car p10) (caadr pts)) (cadr p10))(assoc 11 en) en))
     (entmod (subst '(73 . 1)(assoc 73 en) en))     
    )
  )
)

359321852

自贡黄明儒 发表于 2024-4-2 16:19
根据老迈建议，文字修改后移回原来的基点，这样看起来文字 就不动了
;;BCAD没有JUSTIFYTEXT，仿autocad写 ...

大师，为什么会报错呀？
AOTU cad2014
错误: no function definition: nil

zilong136

自贡黄明儒 发表于 2024-4-2 16:19
根据老迈建议，文字修改后移回原来的基点，这样看起来文字 就不动了
;;BCAD没有JUSTIFYTEXT，仿autocad写 ...

为什么我在选择对齐方式后会出错？

e2002

没有JUSTIFYTEXT的年代，写过这个；后来有了JUSTIFYTEXT，显然就用新的JUSTIFYTEXT了。

Bao_lai

这个文字位置会变么？

广易精通

(command)调用转换为(command-s)运行不了啊大师

tigcat

黄大师产量高,质量好,乐于分享,太感谢了.

caoyongjun

直接文字选中，在属性框里改不香吗

wudechao

caoyongjun 发表于 2024-4-3 21:32
直接文字选中，在属性框里改不香吗

不香，不符合左手键盘，右手鼠标的图农。

KO你

做个面板对话框会更方便使用

hsiga123

BCAD是哪款CAD啊