仿JUSTIFYTEXT

自贡黄明儒 发表于 2024-4-1 14:56

本帖最后由自贡黄明儒于 2024-4-1 16:03 编辑

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

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

(defun C:t1 (/ KEY 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")
)
(MY-JUSTIFYTEXT ss key)
(princ)
)

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

自贡黄明儒 发表于 2024-4-2 16:19

根据老迈建议，文字修改后移回原来的基点，这样看起来文字就不动了
;;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-5-9 10:29

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

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

zilong136 发表于 2024-5-9 10:45

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

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

e2002 发表于 2024-4-1 17:13

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

Bao_lai 发表于 2024-4-1 19:38

这个文字位置会变么？

广易精通 发表于 2024-4-1 20:03

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

tigcat 发表于 2024-4-1 23:32

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

caoyongjun 发表于 2024-4-3 21:32

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

wudechao 发表于 2024-4-3 23:52

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

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

KO你 发表于 2024-4-4 14:52

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

hsiga123 发表于 2024-4-6 01:00

本帖最后由 hsiga123 于 2024-4-6 01:07 编辑

BCAD是哪款CAD啊

页: [1] 2

明经CAD社区's Archiver

仿JUSTIFYTEXT