社区 › Auto Lisp › 有什么常规安排吗

narendra 发表于 2022-7-5 22:25:16

有什么常规安排吗

你好
让我感谢大家在之前的帖子中给予的帮助。。。。。。。。。。现在我带来了另一个问题，客户提供了一个包含大量文本的auto cad图纸，他要求将所有文本放在网格和snap（grid1和snap1）。。。它没有被放置在网格上，并在前面捕捉。如果任何人有例行把所有的文字在网格上的时间，请提供我。

Stefan BMR 发表于 2022-7-5 22:31:39

(defun C:FIXTEXT ( / *error* acDoc round ss d)

(defun round (n) (* d (fix (+ 0.5 (/ (abs n) d))) (if (minusp n) -1 1)))

(vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))

(defun *error* (msg)
   (and
   msg
   (not (wcmatch (strcase msg) "*EXIT*,*QUIT*,*CANCEL*"))
   (princ (strcat "\nError: " msg))
   )
   (vla-endundomark acDoc)
   (princ)
   )

(if
   (and
   (setq ss (ssget ":L" '((0 . "TEXT"))))
   (progn
       (initget 6)
       (setq d (getdist "\nSnap value: "))
   )
   )
   (repeat (setq i (sslength ss))
   (entmod
       (mapcar
         (function
         (lambda (x)
             (if
               (<= 10 (car x) 11)
               (cons (car x) (mapcar 'round (cdr x)))
               x
             )
         )
         )
         (entget (ssname ss (setq i (1- i))))
       )
   )
   )
)
(vla-endundomark acDoc)
(princ)
)

rkent 发表于 2022-7-5 22:36:43

当然，肯特。将（0。“TEXT”）更改为（0。”*TEXT”）或（0。“TEXT，多行文字”）。

Stefan BMR 发表于 2022-7-5 22:44:58

 
谢谢你的推荐，哈桑-
 
通过在代码顶部的列表中添加以下行，该程序可以与文本和多行文字一起使用：

(defun c:round ( / e i k l m s ) ;LEE MAC
   (setq l
      '(
         ("CIRCLE"   10 40)
         ("LINE"       10 11)
         ("LWPOLYLINE" 10)
         ("INSERT"   10)
         ("POINT"      10)
       )
   )            
   (if (null *tol*)
       (setq *tol* 5.0)
   )
   (initget 6)
   (if (setq m (getreal (strcat "\nSpecify rounding tolerance <" (rtos *tol*) ">: ")))
       (setq *tol* m)
       (setq m *tol*)
   )
   (if (setq s (ssget "_:L" '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT"))))
       (repeat (setq i (sslength s))
         (if (setq e (entget (ssname s (setq i (1- i))))
                     k (cdr (assoc (cdr (assoc 0 e)) l))
               )
               (entmod (rounddxf k m e))
         )
       )
   )
   (princ)
)

(defun rounddxf ( key mod lst / rtn )
   (foreach itm lst
       (if (member (car itm) key)
         (setq rtn (cons (cons (car itm) (roundvalue (cdr itm) mod)) rtn))
         (setq rtn (cons itm rtn))
       )
   )
   (reverse rtn)
)

(defun roundvalue ( val mod )
   (if (listp val)
       (mapcar '(lambda ( x ) (round x mod)) val)
       (round val mod)
   )
)

;; Doug Broad
(defun round ( value to )
   (setq to (abs to))
   (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))
)
(princ)

rkent 发表于 2022-7-5 22:48:36

这是我的荣幸李

asos2000 发表于 2022-7-5 22:54:57

感谢stefan BMR、RKENT、LEE MAC、ASOS 2000。
感谢你们的努力和帮助，你们使我的工作变得轻松。。。。。。。谢谢

Stefan BMR 发表于 2022-7-5 22:58:47

感谢您解决如何在网格上移动文本。。。当我这么做的时候，我想到的是这个例程可以被更改为与属性文本一起移动块。ASOS 2000，round例程只是移动块，而不是文本。显然，他习惯于只移动物体而不移动方块。。。

Lee Mac 发表于 2022-7-5 23:03:13

我认为ssget语法中缺少一个。
 
(defun c:round ( / e i k l m s ) ; LEE MAC
   (setq l
      '(
         ("CIRCLE"   10 40)
         ("LINE"       10 11)
         ("LWPOLYLINE" 10)
         ("INSERT"   10)
         ("POINT"      10)
            ("MTEXT"      10)
         ("TEXT"       10 11)
       )
   )
   ...
)

asos2000 发表于 2022-7-5 23:06:12

 
是的，这也是必需的-谢谢。

narendra 发表于 2022-7-5 23:14:20

查看完整版本: 有什么常规安排吗