Leaderboard

Since LT does not support interfacing with objects outside of the AutoCAD Object Model, this program (and several others) is unfortunately not compatible on that platform. Admittedly, I need to update the program to handle the error more gracefully.

Not sure if this is any good. A while ago I thought "That Lee Mac CTX code, I can do that..." just coding not as well as it turns out. I think there are a couple of lines in here that I am not sure if LT will handle - a VLAX- to update the new text string is the main one. (a part of a longer file of text LISPs so while some of this can be done more succinctly, other stuff might be using some of this too.. but also means I might have missed copying something in here) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;ent get or nentget a single entity ;;note entget for example in dimensions, nentget for the rest ;;aprompt: What do you want to ask, Enttype entity type filter, wildard * allowed ;;for example (setq Enttype "TEXT,MTEXT,ATTRIB") ; list of entity to select, except dimensions? (defun getent ( aprompt Enttype / endloop enta entb pt result LP) (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) (setvar "errno" 0) (setq endloop "No") (while (and (= endloop "No")(/= 52 (getvar "errno")) ) (setq LP (getvar "lastpoint")) (setq result (nentselp aprompt)) (cond ((= 'list (type result)) ;;do stuff with ENT (if (not (wcmatch (cdr (assoc 0 (entget (car result)))) Enttype) ) (progn (princ (strcat "\nThats not " Enttype "...\n")) ) ; end progn (progn (setq LMRad (LM:rand)) ; random message (cond ((< LMRad 0.6)(princ "I thank you, that is selected OK. ") ) ((and (< 0.6 LMRad)(< LMRand 0.8))(princ "Got that, thanks. ") ) (T (princ "Awesome. ") ) ) ; end cond (setq enta (car result)) (setq pt (cdr (assoc 10 (entget enta))) ) ;;;;fix for nenset or entsel requirements (setq entb (last (last (nentselp pt)))) (if (not (wcmatch "*DIM*" Enttype) ) ; don't nest these entity types (if (and (/= entb nil) (/= (type entb) 'real) ) (progn (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb)) ) ) ) (setq endloop "Yes") ) ; end progn ) ; end if ) ( (or (= "Exit" result)(= "E" result)) (princ "\n-Cancel or Exit- ") ) ( (= nil result) ;; Missed (if (= LP (getvar "lastpoint"))(princ)(princ (strcat "\nMissed: Select " Enttype ", do try again. Carefully. "))); ) (t (princ ". Sorry, forgot, you're ending the selection. ") (setvar "errno" 52) ) ) ; end conds ) ; end while enta ;;Entity name ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun gettextdxfcodes ( entlist1 / dxfcodes) ;;DXF codes containing texts (setq dxfcodes (list 3 4 1 172 304)) ;;general (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension (progn (if (= (cdr (assoc 1 entlist1)) nil) (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) ) (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on. ) ;end if ) ;end if ));end progn end if Dimensions (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader (progn (setq dxfcodes (list 304)) ));end progn end if Dimensions dxfcodes ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;get text as a string (defun gettextasstring ( enta entcodes / texta ) (if (= (getfroment enta "astring" entcodes) "") () (setq texta (getfroment enta "astring" entcodes)) ) texta ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun compareentities (ent1 ent2 / mycount msg) (setq mycount 0) (while (equal (entget ent1) (entget ent2)) (progn (setq mycount (+ mycount 1)) (princ "\n-- Text 1 and Text 2 are the same. Please select text 2 again.") (setq msg (strcat "\nSelect Text 2 : {" (rtos mycount) "}" ) ) (setq ent2 (getent msg "TEXT,MTEXT,ATTRIB")) ) ) ent2 ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dimensionfix ( ent1 entlist1 entlist2 text01 deldim / ) (if (= "DIMENSION" (cdr (assoc 0 entlist1))) (progn (if (= deldim "del") (txtcleardim ent1 entlist1) ) (if (and (/= "DIMENSION" (cdr (assoc 0 entlist2)))(= text01 nil))(setq text01 (gettextasstring ent1 (list 42)))) ) ) text01 ) (defun txtcleardim (ent1 entlist1 / ) (if (= "DIMENSION" (cdr (assoc 0 entlist1))) (progn (entmod (deletedxfdata ent1 entlist1 (list 1))) (entupd ent1) ) (princ "Thats Not a dimension....") ) ) (defun deletedxfdata ( delent delentlist entcodes / acount acounter ) (setq acounter 0) (setq acount 0) (while (< acount (length entcodes)) (while (< acounter (length delentlist)) (if (= (car (nth acounter delentlist) ) (nth acount entcodes) ) (progn (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist))) (entupd delent) ) ) (setq acounter (+ acounter 1)) );end while (setq acount (+ acount 1)) );end while delentlist ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun addinnewtext (newtext newentlist newent / ) ;; Set to single line text for block attributes ;;https://forums.autodesk.com/t5/autocad-forum/remove-carriage-return/ (if (and (= (cdr (assoc 0 newentlist)) "ATTRIB") ; attribute (wcmatch newtext "*\\P*"); contains any carriage return ) ; end and (while (wcmatch newtext "*\\P*"); then (setq newtext (vl-string-subst " " "\\P" newtext)) ); while ); if (if (/= newtext nil) (progn (cond ( (= (cdr (assoc 0 newentlist)) "DIMENSION") (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist))) (entupd newent) );end condition ( (= (cdr (assoc 0 newentlist)) "RTEXT") (princ "\nRtext: Unwilling to update source file (") (princ (cdr (assoc 1 newentlist)) ) (princ ")") );end condition ;Fix here for attdef or attrib to be dxf code 2 (t ;everything else ;;vla-put-text string for large text blocks + 2000 characters? (vla-put-textstring (vlax-ename->vla-object newent) newtext) );end condition ) ;end cond ) ;end progn (princ "\nSource text is not 'text'") );end if ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:ctx( / entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter explist) ;;get text 1 (setq ent1 (getent "\nSelect New Text : " "TEXT,MTEXT,ATTRIB,*LEADER,DIMENSION")) (setq entlist1 (entget ent1)) (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text. (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string ;;loop till cancelled (while (/= "" (setq ent2 (getent "\nSelect Text To Change or escape: " "TEXT,MTEXT,ATTRIB,*LEADER,DIMENSION"))) ;;get text 2 (setq ent2 (compareentities ent1 ent2)) (setq entlist2 (entget ent2)) (setq entcodes2 (gettextdxfcodes entlist2)) ;;reset entcodes (setq text02 (gettextasstring ent2 entcodes2) ) ;;delete text except for basic DXF code 1 ;;Needed if using entmod method, not VLA-PUT-TEXTSTRING method (setq entlist2 (deletedxfdata ent2 entlist2 entcodes2)) ;;fix for dimensions (Setq text01 (dimensionfix ent1 entlist1 entlist2 text01 "keep")) (Setq text02 (dimensionfix ent2 entlist2 entlist1 text02 "keep")) ;;;put in new text (addinnewtext text01 entlist2 ent2) (command "redraw") (command "regen") ;;update it all );end while ;;Finalise (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq all-hatches (ssget "_X" '((0 . "HATCH")))) (if all-hatches (progn (setq total-hatches (sslength all-hatches)) (setq counter 0) (while (< counter total-hatches) (setq hatch (ssname all-hatches counter)) ; Change the hatch fill to none for each hatch individually (command "-HATCHEDIT" hatch "CO" "." ".") (setq counter (1+ counter)) ) (princ (strcat "\n" (itoa total-hatches) " hatches modified.")) ) (princ "\nNo hatches found.") ) (princ) )

Like this (setq obj (vlax-ename->vla-object (car (entsel "Pick obj")))) (setq pt (getpoint "\nPick point inside cell ")) (If (Eq :Vlax-true (Vla-hittest Obj (Vlax-3d-point (Trans Pt 1 0))(Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) ) (NIL 3 0) = (nil row column)

As an option, you can do it with one click using HitTest, This is ActiveX, so it should be translatable to Autolisp import traceback import PyRx as Rx import PyGe as Ge import PyGi as Gi import PyDb as Db import PyAp as Ap import PyEd as Ed import AxApp24 as Ax def PyRxCmd_deleterow(): try: axApp = Ax.getApp() axDoc = axApp.ActiveDocument #select the cell but also make a slection fence normal = (0, 0, 1) #z hitPnt = axDoc.Utility.GetPoint("\nSelect cell: ") minmax = hitPnt + axDoc.GetVariable("VSMAX") #select using out new fence axSs = axDoc.SelectionSets.Add("AXTBLSS") axSs.SelectByPolygon(Ax.constants.acSelectionSetFence, minmax, [0], ["ACAD_TABLE"]) #run the hittest for axEnt in axSs: axTable = Ax.IAcadTable(axEnt) hit = axTable.HitTest(hitPnt, normal) if hit[0]: axTable.DeleteRows(hit[1],1) except Exception as err: traceback.print_exception(err) finally: axSs.Delete()

Lee-mac has a Hit-test that returns the cell address of a table. Have a look for it. (setq obj (vlax-ename->vla-object (car (entsel "Pick table obj")))) (vla-DeleteRows obj 3 1) ; row how many (vla-put-regeneratetablesuppressed obj :vlax-false) ; regen tablea