为什么最近用的文字居中lisp在cad2014中不能用了

zj20190405

wudechao 发表于 2019-12-23 11:40
(setq ss (ssget '((0 . "TEXT,MTEXT,TCH_TEXT,ATTRIB")))

大佬，可以选择，但是没效果

renyonghua2014

最终版，在AUTOCAD2019, WIN10下，单行文字没能居中（没见动做），大佬再看看。

wudechao

renyonghua2014 发表于 2020-2-2 23:34
最终版，在AUTOCAD2019, WIN10下，单行文字没能居中（没见动做），大佬再看看。

你的cad是精简版本吧？改为完整版本！

renyonghua2014

回，我的acad 2019是完全版非精简版。

wudechao

zj20190405 发表于 2019-12-22 23:05
大佬能不能麻烦添加支持多行文字

修改了 ffg-txtmpt函数，增加支持metxt和TCH_MTEXT。

wudechao

;另外一种方法表格居中（填充判断版），缺点：表格必须封闭（前面那个是交叉线判断，速度快，且表格不需要封闭），这个速度比前面交叉线判断那个wzjz慢很多。优点：前面那个wzjz可能dis倍数问题，交叉线没有和表格相交，可能文字移动不了，这个可以，两个程序互补。建议：优先用前面那个，个别不行，才有这个。论坛某位大师的代码，我增加并修正了MTEXT，TCH_TEXT,TCH_MTEXT。
(defun c:wzjz2 (/ err)
(vl-load-com)
(setvar "cmdecho" 0)
(command ".undo" "be")
(defun algion (msg / ss lst i vlalst boxlst cor1 cor2 findboxpt newboxpt en1 en enlst date1 ty kuandu gaodu pt0)
  (princ msg)
  (setq ss (ssget '((0 . "TEXT,MTEXT,TCH_TEXT,TCH_MTEXT,ATTRIB"))))
  (setq lst nil)
  (setq i 0)
  (setq date1 (getvar "millisecs"))
  (repeat (sslength ss)
   (setq lst (cons (ssname ss i) lst))
   (setq i (1+ i))
  )
  (setq vlalst (mapcar
        'vlax-ename->vla-object
        lst
           )
  )
  (setq boxlst (mapcar
        '(lambda (x / cor1 cor2)
          (vla-getboundingbox x 'cor1 'cor2)
          (setq ty (vlax-get-property x 'objectname))
          (if (= ty "AcDbMText")
           (progn
            (setq x (vlax-vla-object->ename x))
            (setq kuandu (cdr (assoc 42 (entget x))))
            (setq gaodu (cdr (assoc 43 (entget x))))
            (setq pt0 (cdr (assoc 10 (entget x))))
            (setq cor1 (safearray-value cor1)
              cor2 (safearray-value cor2)
            )
            (if (< (- (car pt0) (car cor2)) 0)
             (setq cor2 (list (+ (car pt0) kuandu) (cadr pt0)))
             (setq cor2 (list (- (car pt0) kuandu) (cadr pt0)))
            )
            (if (> (- (cadr pt0) (cadr cor1)) 0)
             (setq cor1 (list (car pt0) (- (cadr pt0) gaodu)))
             (setq cor1 (list (car pt0) (+ (cadr pt0) gaodu)))
            )
            (setq x (vlax-ename->vla-object x))
            (list cor1 cor2)
           )
           (list (vlax-safearray->list cor1) (vlax-safearray->list cor2))
          )
         )
        vlalst
           )
  )
  (setq findboxpt (mapcar
           '(lambda (x)
             (polar (car x) (angle (car x) (cadr x)) (/ (distance (car x) (cadr x)) 2.0))
            )
           boxlst
          )
  )
  (setq newboxpt (mapcar
          '(lambda (x)
            (setq en1 (entlast))
            (vl-cmdf "_boundary" "a" "i" "n" "n" "" x "")
            (setq en (entlast))
            (if (not (equal en1 en))
             (progn
              (setq enlst (entget en))
              (setq lst (vl-remove-if-not '(lambda (y)
                            (= (car y) 10)
                           ) enlst
                )
              )
              (setq cor1 (vl-remove 10 (car lst))
                cor2 (vl-remove 10 (nth 2 lst))
              )
              (entdel en)
              (polar cor1 (angle cor1 cor2) (/ (distance cor1 cor2) 2.0))
             )
            )
           )
          findboxpt
         )
  )
  (mapcar
   '(lambda (x y y2)
     (vla-move x (vlax-3d-point y) (vlax-3d-point y2))
    )
   vlalst
   findboxpt
   newboxpt
  )
  (princ (strcat "耗时\"" (rtos (/ (- (getvar "millisecs") date1) 1000.000) 2 3) "\"秒"))
)
(setq err (vl-catch-all-apply 'algion (list "\n请选择文字: ")))
(command ".undo" "e")
(setvar "cmdecho" 1)
(princ)
)

zj20190405

wudechao 发表于 2020-2-19 01:47
;另外一种方法表格居中（填充判断版），缺点：表格必须封闭（前面那个是交叉线判断，速度快，且表格不需要 ...

顶贴是美德....顶贴是美德....顶贴是美德....顶贴是美德....顶贴是美德....顶贴是美德....

zj20190405

wudechao 发表于 2020-2-19 01:47
;另外一种方法表格居中（填充判断版），缺点：表格必须封闭（前面那个是交叉线判断，速度快，且表格不需要 ...

顶贴是美德....顶贴是美德....顶贴是美德....顶贴是美德....顶贴是美德....

YEGQ

wudechao 发表于 2019-11-16 23:21
；文字表格秒居中（交叉线判断版）,终结版本（经多次测试，比填充方式找中点约快215倍,2020.2.18修改 ffg-t ...

好用是挺好用。有时候点了没反应，也没返回时间？最终版， 要全部把直线打散才能用？
直接把代码另存为lsp调用不了把，报; 错误: 输入中的点位置不正确

paulpipi

确实好用，感谢分享