判断文字压盖

cz78873559 · 发表于 2014-6-12 10:33:14

请求高手帮忙: 所选图中的（单行）文字，如果文字有互相压盖的，则把此文字颜色变成绿色。谢谢！

soly2006 · 发表于 2014-6-12 13:37:46

;;---------------------=={ Get Text Box }==-------------------;;
;; ;;
;; Returns a point list describing a rectangle framing the ;;
;; specified text or mtext entity with optional offset ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; ent - Text or MText ename ;;
;; off - offset (may be zero) ;;
;;------------------------------------------------------------;;
;; Returns: List of Points (in OCS) describing text frame ;;
;;------------------------------------------------------------;;
(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix )
;; ?Lee Mac 2010
(setq dx (lambda ( x l ) (cdr (assoc x l))))
(if
(setq lst
(cond
(
(eq "TEXT" (dx 0 (setq l (entget ent))))
(setq base (dx 10 l) rotn (dx 50 l))
(
(lambda ( data )
(mapcar
(function
(lambda ( funcs )
(mapcar
(function
(lambda ( func )
((eval (car func)) ((eval (cdr func)) data) off)
)
)
funcs
)
)
)
(list
(list (cons '- 'caar ) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '+ 'cadadr))
(list (cons '- 'caar ) (cons '+ 'cadadr))
)
)
)
(textbox l)
)
)
(
(eq "MTEXT" (dx 0 l))
(setq norm (dx 210 l) base (trans (dx 10 l) 0 norm)
rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm))
w (dx 42 l) h (dx 43 l)
)
(
(lambda ( org )
(mapcar
(function
(lambda ( o ) (mapcar '+ org o))
)
(list
(list (- off) (- off))
(list (+ w off) (- off))
(list (+ w off) (+ h off))
(list (- off) (+ h off))
)
)
)
(
(lambda ( j )
(list
(cond
(
(member j '(2 5 8)) (/ w -2.)
)
(
(member j '(3 6 9)) (- w)
)
( 0. )
)
(cond
(
(member j '(1 2 3)) (- h)
)
(
(member j '(4 5 6)) (/ h -2.)
)
( 0. )
)
)
)
(dx 71 l)
)
)
)
)
)
(progn
(setq matrix
(list
(list (cos rotn) (sin (- rotn)) 0.)
(list (sin rotn) (cos rotn) 0.)
(list 0. 0. 1.)
)
)
(mapcar
(function
(lambda ( point )
(mapcar '+
(mapcar
(function
(lambda ( r ) (apply '+ (mapcar '* r point)))
)
matrix
)
(reverse (cdr (reverse base)))
)
)
)
lst
)
)
)
)

;;---------------------=={ Get Text Box }==-------------------;; 
;;                                                            ;; 
;;  Returns a point list describing a rectangle framing the   ;; 
;;  specified text or mtext entity with optional offset       ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ?2010 - www.lee-mac.com       ;; 
;;------------------------------------------------------------;; 
;;  Arguments:                                                ;; 
;;  ent - Text or MText ename                                 ;; 
;;  off - offset (may be zero)                                ;; 
;;------------------------------------------------------------;; 
;;  Returns:  List of Points (in OCS) describing text frame   ;; 
;;------------------------------------------------------------;; 
 
(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix ) 
  ;; ?Lee Mac 2010 
 
  (setq dx (lambda ( x l ) (cdr (assoc x l)))) 
 
  (if 
    (setq lst 
      (cond 
        ( 
          (eq "TEXT" (dx 0 (setq l (entget ent)))) 
 
          (setq base (dx 10 l) rotn (dx 50 l)) 
 
          ( 
            (lambda ( data ) 
              (mapcar 
                (function 
                  (lambda ( funcs ) 
                    (mapcar 
                      (function 
                        (lambda ( func ) 
                          ((eval (car func)) ((eval (cdr func)) data) off) 
                        ) 
                      ) 
                      funcs 
                    ) 
                  ) 
                ) 
                (list 
                  (list (cons '- 'caar ) (cons '- 'cadar )) 
                  (list (cons '+ 'caadr) (cons '- 'cadar )) 
                  (list (cons '+ 'caadr) (cons '+ 'cadadr)) 
                  (list (cons '- 'caar ) (cons '+ 'cadadr)) 
                ) 
              ) 
            ) 
            (textbox l) 
          ) 
        ) 
        ( 
          (eq "MTEXT" (dx 0 l)) 
 
          (setq norm (dx 210 l) base (trans (dx 10 l) 0 norm) 
          
                rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm)) 
 
                w (dx 42 l) h (dx 43 l) 
          ) 
          ( 
            (lambda ( org ) 
              (mapcar 
                (function 
                  (lambda ( o ) (mapcar '+ org o)) 
                ) 
                (list 
                  (list (-   off) (-   off)) 
                  (list (+ w off) (-   off)) 
                  (list (+ w off) (+ h off)) 
                  (list (-   off) (+ h off)) 
                ) 
              ) 
            ) 
            ( 
              (lambda ( j ) 
                (list 
                  (cond 
                    ( 
                      (member j '(2 5 8)) (/ w -2.) 
                    ) 
                    ( 
                      (member j '(3 6 9)) (- w) 
                    ) 
                    ( 0. ) 
                  ) 
                  (cond 
                    ( 
                      (member j '(1 2 3)) (- h) 
                    ) 
                    ( 
                      (member j '(4 5 6)) (/ h -2.) 
                    ) 
                    ( 0. ) 
                  ) 
                ) 
             ) 
             (dx 71 l) 
           ) 
         ) 
       ) 
     ) 
   ) 
    (progn 
      (setq matrix 
         (list 
           (list (cos rotn) (sin (- rotn)) 0.) 
           (list (sin rotn) (cos    rotn)  0.) 
           (list     0.           0.       1.) 
         ) 
      ) 
 
      (mapcar 
        (function 
          (lambda ( point ) 
            (mapcar '+ 
              (mapcar 
                (function 
                  (lambda ( r ) (apply '+ (mapcar '* r point))) 
                ) 
                matrix 
              ) 
              (reverse (cdr (reverse base))) 
            ) 
          ) 
        ) 
        lst 
      ) 
    ) 
  ) 
)

自贡黄明儒 · 发表于 2014-6-12 12:51:43

选求得文字四个角点，然后(ssget "CW" '(list p1 p2 p3 p4) '((0 . *Text)))

cz78873559 · 发表于 2014-6-12 13:03:38

谢谢，能给我完整的代码吗？非常感谢！我是菜鸟……

cz78873559 · 发表于 2014-6-12 14:07:00

谢谢，运行后提示参数太少。

819534890 · 发表于 2014-6-12 17:52:51

利用地板的函数，给你做了个，看看是否合用。

(vl-load-com)
(defun c:gt1(/ sstext text_sn cpl i)
(setq sstext (ssget '((0 . "text"))))
(if sstext
(progn
(setq i 0)
(repeat (sslength sstext)
(setq text_sn (ssname sstext i)
plst (LM:GetTextBox text_sn 0)
cpl (ssget "CP" plst '((0 . "text")))
)
(if (> (sslength cpl) 1)
(vla-put-color (vlax-ename->vla-object text_sn) 3)
)
(setq i (1+ i))
))))

cz78873559 · 发表于 2014-6-13 14:03:31

819534890 发表于 2014-6-12 17:52
利用地板的函数，给你做了个，看看是否合用。

非常感谢！能实现检查功能了。只不过文字样式似乎有影响，如果文字样式为宋体，选择过多会提示参数错误。如果样式为hz则不会提示错误。能优化此问题吗？

账号		自动登录	找回密码
密码			注册

[已解答] 判断文字压盖

浏览过的版块