社区 › Auto Lisp › 多重引线包络处理

Lee Mac 发表于 2022-7-5 18:26:32

 
如果你有耐心等待我的回应，这是可能的

Lee Mac 发表于 2022-7-5 18:32:59

下面是一个函数的草稿，用于确定具有文本内容的多重引线的文本框：

;; MLeader Textbox-Lee Mac
;; Returns four OCS points describing the textbox of the content for a given MLeader
;; ent - MLeader entity

(defun LM:mleadertextbox ( ent / bpt enx hgt jus lst mat org prp rot wid )
   (if (= acmtextcontent (cdr (assoc 172 (reverse (setq enx (entget ent))))))
       (progn
         (setq prp (list (cons 40 (cdr (assoc 41 enx)))
                           (cons 07 (cdr (assoc 02 (entget (cdr (assoc 340 enx))))))
                     )
               lst (vl-remove-if 'null
                         (mapcar
                            '(lambda ( str / box )
                                 (if (setq box (textbox (cons (cons 1 str) prp)))
                                     (mapcar '- (cadr box) (car box))
                                 )
                           )
                           (LM:str->lst (cdr (assoc 304 enx)) "\\P")
                         )
                     )
               bpt (trans (cdr (assoc 12 enx)) 0 (cdr (assoc 11 enx)))
               rot (cdr (assoc 042 enx))
               jus (cdr (assoc 171 enx))
               wid (apply 'max (mapcar 'car lst))
               hgt (+ (apply '+ (mapcar 'cadr lst)) (* 0.68 (cdr (assoc 45 enx)) (1- (length lst))))
               org (list (cond ((member jus '(2 5 ) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid))      (0.0))
                           (cond ((member jus '(1 2 3)) (- hgt))      ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0))
                     )
               mat (list
                         (list (cos rot) (sin (- rot)) 0.0)
                         (list (sin rot) (cos rot)   0.0)
                        '(0.0 0.0 1.0)
                     )
         )
         (mapcar '(lambda ( p ) (mapcar '+ (mxv mat p) bpt))
               (list org
                   (mapcar '+ org (list wid   0))
                   (mapcar '+ org (list wid hgt))
                   (mapcar '+ org (list 0   hgt))
               )
         )
       )
   )
)

;; String to List-Lee Mac
;; Separates a string using a given delimiter
;; str - String to process
;; del - Delimiter by which to separate the string
;; Returns: List of strings

(defun LM:str->lst ( str del / pos )
   (if (setq pos (vl-string-search del str))
       (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
       (list str)
   )
)

;; Matrix x Vector-Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
   (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
 
和一个小测试程序：
(defun c:test ( / e v )
   (if (setq e (ssget "_+.:E:S" '((0 . "MULTILEADER"))))
       (progn
         (setq e (ssname e 0)
               v (cdr (assoc 11 (entget e)))
         )
         (foreach x (LM:mleadertextbox e)
               (entmake (list '(0 . "POINT") (cons 10 (trans x v 0))))
         )
       )
   )
   (princ)
)

Rosamund Kwan 发表于 2022-7-5 18:38:54

 
尊敬的LeeMac：
非常感谢。非常感谢你及时的帮助！

ksperopoulos 发表于 2022-7-5 18:42:12

为了消除步骤，在图形中放置多重引线时，是否有方法确定多重引线文本的边界？

查看完整版本: 多重引线包络处理