CADForums.net

m|sf|t · Guest

All,
Are there any routines out there that allow you to:
1) select a TEXT entity, then
2) select a LINE, then
3) MOVE the TEXT to the MIDPOINT of the LINE using the TEXTs' BASE POINT ?

This is a small section of a larger project that I am starting.
Thanks.

T.Willey · Guest

Try this. Very simple, can and should be improved apon.

Tim

(defun c:MoveText2Line (/ TEnt TObj LEnt LObj TxPt)

(vl-load-com)
(setq TEnt (entsel "\n Select text object: "))
(setq LEnt (entsel "\n Select line object: "))
(if (and TEnt Lent)
(progn
(setq TObj (vlax-ename->vla-object (car TEnt)))
(setq LObj (vlax-ename->vla-object (car LEnt)))
(setq TxPt
(mapcar '(lambda (x y) (/ (+ x y) 2))
(safearray-value (variant-value (vla-get-EndPoint LObj)))
(safearray-value (variant-value (vla-get-StartPoint LObj)))
)
)
(if (= (vla-get-Alignment TObj) 0)
(vla-put-InsertionPoint TObj (vlax-3d-point TxPt))
(vla-put-TextAlignmentPoint TObj (vlax-3d-point TxPt))
)
)
)
)

Kent Cooper, AIA · Guest

Just curious...

I can see doing this with a "routine" if you wanted to move a piece of text
to the midpoint of a line where they were both known from some other earlier
part of the "larger project", in other words, so the text could be moved
without further user input. But if you're going to have the user select the
text and the line in this operation anyway, I'm wondering why you need a
routine at all. Simply pick the text item, grab its insertion point grip,
and haul it to the midpoint of the line (with either running or selected
midpoint osnap). No coding required, no typing in the name of the defun'd
command, no error handling, no muss, no fuss, no bother.

Just curious...
--
Kent Cooper, AIA

"m|sf|t" wrote...

T.Willey · Guest

It is a smaller part of the routine, but I just wrote it as it's own routine. The OP can change it to meet there needs.

Tim

Charliep · Guest

This is what I use, I don't recall where I got it from, but works for me.

;extract data from dotted pair
(defun dxf (code elist) (cdr (assoc code elist)))

;from www.acadx.com
(defun massoc (key alist / x nlist)
(foreach x alist
(if (eq key (car x))
(setq nlist (cons (cdr x) nlist))
)
)
(reverse nlist)
)

;change entity list contents if found otherwise add to list
(defun elist (el grp new)
(if (assoc grp el)
(subst (cons grp new) (assoc grp el) el)
(append el (list (cons grp new)))
)
)

(defun TEXTXY (WHICH / A CNT PNT DATA NEWPNT 330S 330CNT CHECK LEADER
LEADERS X Y)
(setq A (ssget '((0 . "*text,ATTDEF"))))
(setq CNT 0)
(initget 1)
(setq PNT (getpoint (strcat "\n" WHICH " POINT: ")))
(repeat (sslength A)
(setq DATA (entget (ssname A CNT))
LEADER NIL
LEADERS NIL
)
(cond
((= "MTEXT" (DXF 0 DATA)) (setq INS 10))
((or (not (zerop (DXF 72 DATA))) (not (zerop (DXF 73 DATA))))
(setq INS 11)
)
(t (setq INS 10))
)
(if (= WHICH "X")
(setq NEWPNT
(trans
(list (car PNT) (cadr (trans (DXF INS DATA) 0 1)) 0.0)
1
0
)
)
(setq NEWPNT
(trans
(list (car (trans (DXF INS DATA) 0 1)) (cadr PNT) 0.0)
1
0
)
)
)
(setq CHECK t
330S (MASSOC 330 DATA)
330CNT 0
)
(foreach X 330S
(setq LEADER (entget X))
(if (= "LEADER" (DXF 0 LEADER))
(setq LEADERS (cons (list X
(mapcar '-
(last (MASSOC 10 LEADER))
(DXF INS DATA)
)
)
LEADERS
)
)
)
)
(setq DATA (entmod (ELIST DATA INS NEWPNT)))
(foreach Y LEADERS
(entmod (reverse (ELIST (reverse (entget (car Y)))
10
(mapcar '+ (cadr Y) (DXF INS DATA))
)
)
)
)
(setq CNT (1+ CNT))
)
(princ)
)
(defun C:TX () (TEXTXY "X") (princ))
(defun C:TY () (TEXTXY "Y") (princ))

	CADForums.net Forum Index -> Customization	All times are GMT
Page 1 of 1