[编程交流] 查找文本和中间点

(setq ss (ssget (list (cons 0 "Text"))))
(setq len (sslength ss))
(setq x 0)
(repeat len
(setq en1 (ssname ss x))
       (setq el1 (entget en1))
       (setq v1 (atof (cdr (assoc 10 el1))))
(princ v1)
)

(defun c:Test (/ string sset c ent insp point)
 ;;Ganesh Shetty 
 (if (setq string (strcase (getstring t "\nEnter String:: ")))
     (progn
   (if (setq sset (ssget "x"  (list (cons 0 "TEXT,MTEXT"))))
       (progn
             
             (repeat (setq c (sslength sset))
                 (setq ent (entget (ssname sset (setq c (1- c)))))
                 (if (equal (strcase (cdr (assoc 1 ent))) string)
                     (progn
                          (if (or (= "MTEXT" (cdr (assoc 0 ent)))
                                  (and
                                      (zerop (cdr (assoc 72 ent)))
                                      (zerop (cdr (assoc 73 ent)))
                                  )
                              )
                              (setq insp (cdr (assoc 10 ent)))
                              (setq insp (cdr (assoc 11 ent)))
                           )
                           (setq point (strcat "E-" (rtos (car insp)) "," "N-" (rtos (cadr insp))))
                           (princ "\n")
                           (princ point)
                      )
                   )
               )
         )
     )
)
   )
 (princ))

;;; mid point of text or mtext ;;;
;;; JDiala 09-23-2013 ;;;
(vl-load-com)
(defun c:test (/ s ss pl)
(if
 (setq ss (ssget "_X" (list (cons 0 "TEXT,MTEXT") (cons 1 (setq s (getstring t "\nEnter String :"))))))
 (progn
   (repeat (setq i (sslength ss))
     (vla-GetBoundingBox 
       (vlax-ename->vla-object 
         (ssname ss (setq i (1- i)))
       ) 'p1 'p2
      )
    (setq pl 
      (cons 
        (mapcar 
       (function 
         (lambda (a b) (/ (+ a b) 2.))
          ) 
       (vlax-safearray->list p1) 
       (vlax-safearray->list p2))  
       pl
       )
     )
)
(princ pl)
   )
 (princ (strcat "\nNothing found with "" s " " string on the drawing!"))
)
(princ)
)

(defun c:Test2(/ s sset ent bpt ang tb pt1 mpoint)
 ;Gs7
 (if (setq s (strcase (getstring t "\nEnter String::")))
     (progn
   (if (setq sset (ssget "_x" (list (cons 0 "TEXT,MTEXT"))))
       (progn
            (repeat (setq c (sslength sset))
                (setq ent (entget (ssname sset (setq c(1- c)))))
                (if (equal (strcase (cdr (assoc 1 ent))) s)
                    (progn
                        (setq Bpt (cdr (assoc 10 ent)))
                        (setq ang (cdr (assoc 50 ent)))
                        (setq Tb  (cadr (textbox (list (assoc -1 ent)))))
                        (setq pt1 (polar bpt ang (/ (car tb) 2.0)))
                        (setq mpoint (polar pt1 (+ ang (/ pi 2.0)) (/ (cadr tb) 2.0)))
                        (princ "\n")
                        (princ mpoint)
                    )
                 )
              )
         )
     )
)
   )
 (princ))

;;Ganesh Shetty 
;;27.09.2013
(defun c:blkl(/ string ss space n e p1 p2)
 (vl-load-com)
 (if
    (and
        (setq string (getstring "\nEnter String::"))
 (setq ss (ssget "X" '((0 . "INSERT") (66 . 1))))
    )
    (progn
          (setq space (vla-get-modelspace
                     (vla-get-activedocument
                          (vlax-get-acad-object)
                     )
               )
   )
          (setq n (substr string 3 6))
          (repeat (setq i (sslength ss))
      (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (foreach b
               (Vlax-SafeArray->List
                      (variant-value
                           (vla-getattributes e)
                      )
               )
               (cond
                    ((equal (strcase(vla-get-Textstring b)) (strcase String))
                     (setq p1 (vla-get-textalignmentpoint b))
                    )
                    ((equal (vla-get-textstring b) n)
                      (setq p2 (vla-get-Textalignmentpoint b))
                    )
               )
      )
  )
         (vla-addline space p1 p2)
      )
   )
 (princ))