Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/29/2020 in all areas

  1. Try this minor modification. This now works with TEXT and MTEXT provided the TEXT or MTEXT are just integers or reals (Not a mix of alphanumeric characters). It ignores any MTEXT formatting. If a MTEXT text is the first text selected, the inserted TEXT total will be in the mtext style but have a default text width. (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun (vl-load-com) (defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_defun (while (not tot) (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : "))))) (cond ( (wcmatch (cdr (assoc 0 el)) "*TEXT") (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")))) (t (setq num (atof (getpropertyvalue ent "Text")))) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")) (t (setq tot num))) ) (t (alert "Not a Text Entity")) );end_cond (cond (num (setq nlst (cons ent nlst)))) );end_while (while (setq sel (entsel "\nSelect Next Text Number Entity : ")) (setq elst (entget (setq ent (car sel)))) (cond ( (wcmatch (cdr (assoc 0 elst)) "*TEXT") (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (getpropertyvalue ent "TextString")))) (t (setq num (atof (getpropertyvalue ent "Text")))) );end_cond (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number"))) ) (t (alert "Not a Text Entity")) );end_cond (if num (setq tot (+ tot num) nlst (cons ent nlst))) );end_while (cond (tot (setq pt (getpoint "\nSelect Total Insertion Point : ") txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)) );end_setq (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el))) (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o))) ) );end_cond (princ) );end_defun
    1 point
  2. Try this oldie of mine, updated to delete the picked texts. This only works with "TEXT" and not "MTEXT". Total text is in layer and style of first selected text. (defun rh:em_txt ( pt txt lyr sty tht xsf) (entmakex (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") (cons 10 pt) (cons 1 txt) (if lyr (cons 8 lyr)) (if sty (cons 7 sty)) (if tht (cons 40 tht)) (if xsf (cons 41 xsf)) );end_list );end_entmakex );end_defun (vl-load-com) (defun c:t+ ( / *error* ent elst el num tot nlst sel pt txt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred."))) (princ) );end_defun (while (not tot) (setq el (entget (setq ent (car (entsel "\Select First Text Number Entity : "))))) (cond ( (= (cdr (assoc 0 el)) "TEXT") (setq num (atof (cdr (assoc 1 el)))) (cond ( (zerop num) (setq tot nil) (alert "Text Entity NOT a number")) (t (setq tot num)))) (t (alert "Not a Text Entity")) );end_cond (cond (num (setq nlst (cons ent nlst)))) );end_while (while (setq sel (entsel "\nSelect Next Text Number Entity : ")) (setq elst (entget (setq ent (car sel)))) (cond ( (= (cdr (assoc 0 elst)) "TEXT") (setq num (atof (cdr (assoc 1 elst)))) (cond ( (zerop num) (setq num nil) (alert "Text Entity NOT a number")))) (t (alert "Not a Text Entity")) );end_cond (if num (setq tot (+ tot num) nlst (cons ent nlst))) );end_while (cond (tot (setq pt (getpoint "\nSelect Total Insertion Point : ") txt (if (zerop (rem tot 1.0)) (rtos tot 2 0) (rtos tot 2 3)) );end_setq (rh:em_txt pt txt (cdr (assoc 8 el)) (cdr (assoc 7 el)) (cdr (assoc 40 el)) (cdr (assoc 41 el))) (if nlst (foreach o (mapcar 'vlax-ename->vla-object nlst) (vla-delete o))) ) );end_cond (princ) );end_defun
    1 point
×
×
  • Create New...