社区 › Auto Lisp › 单线te周围的多段线

alanjt 发表于 2022-7-6 00:29:10

从LISP中，不能这样调用另一个LISP例程。

Lt Dan's l 发表于 2022-7-6 00:33:22

很高兴知道。非常感谢。

alanjt 发表于 2022-7-6 00:37:02

解决。。。
 
(defun c:Test (/ ss)
(if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
   (progn (sssetfirst nil ss)
          (vla-sendcommand
            (cond (*AcadDoc*)
                  ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
            )
            "_.TCIRCLE 0.3 RECTANGLES VARIABLE "
          )
   )
)
(princ)
)

Lee Mac 发表于 2022-7-6 00:41:04

SendCommand-在极少数情况下，是非常有用的东西

alanjt 发表于 2022-7-6 00:44:13

罕见，如果小心使用。

Lee Mac 发表于 2022-7-6 00:44:51

为了提供替代方案，这应该适用于任何UCS或视图中的所有文本：
 

(defun c:tBox ( / ss )
;; © Lee Mac 2010

(if
   (and
   (setq ss(ssget '((0 . "TEXT"))))
   (setq *o*
       (cond
         (
         (getdist
             (strcat "\nSpecify Offset <"
               (rtos
               (setq *o*
                   (cond ( *o* ) ( (* 0.5 (getvar 'TEXTSIZE)) ))
               )
               )
               "> : "
             )
         )
         )
         ( *o* )
       )
   )
   )
   (
   (lambda ( i / e )
       (while (setq e (ssname ss (setq i (1+ i))))
         (entmakex
         (append
             (list
               (cons 0 "LWPOLYLINE")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbPolyline")
               (assoc 8 (entget e))
               (cons 90 4)
               (cons 70 1)
               (cons 38 (caddr (dxf 10 (entget e))))
               (assoc 210 (entget e))
             )
             (mapcar '(lambda ( x ) (cons 10 x)) (LM:TextBox e *o*))
         )
         )
       )
   )
   -1
   )
)

(princ)
)
                        
(defun dxf ( code lst ) (cdr (assoc code lst)))

;;---------------------=={ Text Box }==-----------------------;;
;;                                                            ;;
;;Returns the coordinates (in OCS) of the rectangle         ;;
;;enclosing the specified Text entity with specified offset ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;Arguments:                                                ;;
;;ent    - Text Entity                                    ;;
;;offset - Optional offset                                  ;;
;;------------------------------------------------------------;;
;;Returns:List of Points (in OCS) framing the text      ;;
;;------------------------------------------------------------;;

(defun LM:TextBox ( ent offset / el base ang m )
;; © Lee Mac 2010

(if (eq "TEXT" (dxf 0 (setq el (entget ent))))
   (mapcar
   (function
       (lambda ( x ) (mapcar (function +) (mxv m x) base))
   )
   (progn
       (setq base (reverse (cdr (reverse (dxf 10 el)))) ;; 2D OCS
             ang(dxf 50 el) ;; to OCS X-axis

            m   (list
                  (list (cos ang) (- (sin ang)) 0)
                  (list (sin ang)    (cos ang)0)
                  (list    0             0      1)
                  )
       )
       (
         (lambda ( data )
         (mapcar
             (function
               (lambda ( g )
               (mapcar
                   (function
                     (lambda ( f ) ((eval f) data))
                   )
                   g
               )
               )
             )
            '(
               (
               (lambda ( x ) (- (caar   x) offset))
               (lambda ( x ) (- (cadarx) offset))
               )
               (
               (lambda ( x ) (+ (caadrx) offset))
               (lambda ( x ) (- (cadarx) offset))
               )
               (
               (lambda ( x ) (+ (caadrx) offset))
               (lambda ( x ) (+ (cadadr x) offset))
               )
               (
               (lambda ( x ) (- (caar   x) offset))
               (lambda ( x ) (+ (cadadr x) offset))
               )
             )
         )
         )
         (textbox el)
       )
   )
   )
)
)

(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

ccowgill 发表于 2022-7-6 00:49:04

有没有一种简单的方法来修改这个程序，使其同时适用于多行文字和多重引线？我在多重引线上使用dxf时出现错误，在选择多行文字时，它似乎不会绘制任何内容。

Lee Mac 发表于 2022-7-6 00:52:30

此处为最新代码：
 
http://lee-mac.com/boxtext.html
 
虽然我没有将其修改为与MLeaders一起使用，但这是可以做到的。

ccowgill 发表于 2022-7-6 00:55:39

谢谢，我不得不做一些作弊，因为多导文字与多行文字的属性并不完全相同，但在我的测试中似乎确实有效。

Lee Mac 发表于 2022-7-6 01:00:07

 
不客气，克里斯

查看完整版本: 单线te周围的多段线