Leaderboard

Calculate the bounding box of the text object, and then calculate the midpoint of the diagonal, e.g.: (defun c:test ( / b e ) (cond ( (not (setq e (car (nentsel))))) ( (not (setq b (LM:textbox (entget e)))) (princ "\nInvalid object selected - please select text, mtext or attribute.") ) ( (entmake (list '(000 . "POINT") (cons 010 (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0)) (assoc 210 (entget e)) ) ) ) ( (princ "\nUnable to create central point.")) ) (princ) ) ;; Text Box - Lee Mac (based on code by gile) ;; Returns the bounding box of a text, mtext, or attribute entity (in OCS) (defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid ) (cond ( (and (= "ATTRIB" (cdr (assoc 000 enx))) (= "Embedded Object" (cdr (assoc 101 enx))) ) (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx))) ) ( (cond ( (wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT") (setq bpt (cdr (assoc 010 enx)) rot (cdr (assoc 050 enx)) lst (textbox enx) lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst))) ) ) ( (= "MTEXT" (cdr (assoc 000 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 010 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs)) wid (cdr (assoc 042 enx)) hgt (cdr (assoc 043 enx)) jus (cdr (assoc 071 enx)) org (list (cond ((member jus '(2 5 8)) (/ 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)) ) lst (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt))) ) ) ) ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) ) ;; 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) ) ;; 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) )

Another for fun: (setq l '(("1" "a") ("2" "b") ("2" "c") ("2" "d") ("3" "e"))) (setq k '("1" "2" "3")) (mapcar '(lambda (x) (cons x (vl-remove-if-not '(lambda (y) (= x (car y))) l))) k)

Consider the following - (defun foo ( a b / y ) (setq a (mapcar 'list a)) (foreach x (reverse b) (if (setq y (assoc (car x) a)) (setq a (subst (vl-list* (car x) x (cdr y)) y a)) ) ) a ) For example: _$ (foo '("1" "2" "3" "4") '(("1" "a") ("2" "b") ("2" "c") ("2" "d") ("3" "e") ("4" "f"))) (("1" ("1" "a")) ("2" ("2" "b") ("2" "c") ("2" "d")) ("3" ("3" "e")) ("4" ("4" "f"))) I'm unsure how you wish to handle these cases: _$ (foo '("1" "2" "3" "4" "5") '(("1" "a") ("2" "b") ("2" "c") ("2" "d") ("3" "e") ("4" "f"))) (("1" ("1" "a")) ("2" ("2" "b") ("2" "c") ("2" "d")) ("3" ("3" "e")) ("4" ("4" "f")) ("5")) _$ (foo '("1" "2" "3" "4") '(("1" "a") ("5" "f"))) (("1" ("1" "a")) ("2") ("3") ("4"))

CircuitExample.dwg

thank you for your help

Like this (setq ent (car (entsel "\nPick text"))) (command "justifytext" ent "" "MC") (setq pt (cdr (assoc 11 (entget ent)))) (command "undo" 1) No Justifytext in Bricscad V20 ?

Lee's way is probably simplest but you can do something like this change the text to middle centre then retrieve the entget dxf 11 will show the centre so you would entmod 1st making it central then entget again. Will try to find some time to try it out.

Thank you for bringing this issue to my attention - I have now corrected the code on my site.

Give this version a try: (defun c:foo (/ _aap a d l lines p p2 ss text x) ;; RJP » 2021-10-06 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,*Text")))) (progn (or (setq d (getdist "\nEnter offset distance:<0> ")) (setq d 0)) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT") (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (entmod (subst (cons 50 ((lambda (x) (setq a (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) ) (caddr l) ) ) (assoc 50 (entget x)) (entget x) ) ) ) ) ; <--- Modified by Jonathan Handojo ;; RJP added offset (entmod (subst (cons 10 (polar (car l) (+ (/ pi 2) a) d)) (assoc 10 (entget x)) (entget x)) ) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )

Thank you mhupp. I tested your revision and it works on all planes. Problem Solved!

To supplement BIGAL's post, take a look HERE for wcmatch reference.

For mtext: ;; Change this (setq ss (ssget '((0 . "*polyline,Line,Text")))) ;; to this (setq ss (ssget '((0 . "*polyline,Line,*Text")))) ;; and this (if (= "TEXT" (cdr (assoc 0 (entget x)))) ;; to this (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT")

Glad to help out!

Try this .. it was bonking out because the _aap function was returning nil. (defun c:foo (/ _aap l lines p p2 ss text) ;; RJP - 6.14.2017 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,Text")))) (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (= "TEXT" (cdr (assoc 0 (entget x)))) (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (entmod (subst (cons 50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) (caddr l) ) ) (assoc 50 (entget x)) (entget x) ) ) ) ) ; <--- Modified by Jonathan Handojo (entmod (subst (cons 10 (car l)) (assoc 10 (entget x)) (entget x))) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )