Leaderboard
Popular Content
Showing content with the highest reputation since 06/01/2025 in all areas
-
After seeing @BIGAL's suggestion, I'm wondering if I understood correctly what you're asking, Vica. Anyway, I'm attaching a short clip of what I'm talking about. FACTVM de ARCTIS.mp4 I’ve implemented a small emulator of the "pline" command in the base code, but each user should implement the code they need for their specific task instead. Basically, the distance variation from the last stored point in LASTPOINT is displayed above the cursor (though this can be easily changed by modifying the textoGR1 function). Below the cursor, any desired information about the object under it will be shown (or not, if visibility is toggled by pressing the F10 key). This information must be passed to the textoGR2 function as a list of (Property_Name StringValue) pairs. The main code must be implemented in the 'FuncionPrincipal' function.6 points
-
https://www.theswamp.org/index.php?topic=30650.msg378483#msg3784834 points
-
Better armored version, proof against extravagant users ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:mueveSegmto (/ lstSg dist i se lado op pr pr1 pa pb p1 p2 p3 p4 sgC r aC aR asr dameSgmtos erroria errores error0) (defun erroria () (defun errores (mens) (setq *error* error0) (prin1) ) (setq error0 *error* *error* errores ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun dameSgmtos (x pk / f d p s a tam a1 a2 b1 b2 c1 c2 sa sp) (if (= (cdr (assoc 0 x)) "LWPOLYLINE") (progn (setq tam (* (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (setq ss (getvar "SCREENSIZE"))) ) ) 2 ) x (if (= (rem (cdr (assoc 70 x)) 2) 1) (cons (assoc 10 (reverse x)) x) x) b2 (cdr (assoc 10 (cdr (member (cons 10 (setq b1 (cdr (assoc 10 x)))) x)))) c1 (cdr (assoc 10 (cdr (member (cons 10 (setq c2 (cdr (assoc 10 (reverse x))))) (reverse x))))) ) (while (and (setq a1 (cdr p) a2 f f (cdr (assoc (if pk 10 11) (setq x (cdr (member (setq p (assoc 10 x) ) x)))))) (not (setq i (inters f (cdr p) (polar pk (+ (setq a (angle f (cdr p))) 1.5708) tam) (polar pk (- a 1.5708) tam)) )) ) ) (setq sc (list (cdr p) f) f (cdr (assoc (if pk 10 11) (cdr (member (setq p (assoc 10 x)) x)))) sp (if f (list (cdr p) f) (list b1 b2)) sa (if a1 (list a1 a2) (list c1 c2)) ) (list sa sc sp) ) ) ) (erroria) (setq dist (getreal "\nDistance of traslation (ENTER to get the distance on screen): ")) (if (setq lstSg (dameSgmtos (entget (car (setq se (entsel "\nSelect any segment in LWPOLYLINE...")))) (setq pr (cadr se)))) (if (setq pr1 (getpoint (setq pr i) "\nSide to act...")) (if (setq op (asr (setq p2 (car (setq sgC (cadr lstSg)))) pr pr1)) (setq dist (if dist dist (distance pr1 (inters p2 (setq p3 (cadr sgC)) (polar pr1 (- (setq aR (angle p2 p3)) (/ pi 2)) 9999) (polar pr1 (+ aR (/ pi 2)) 9999) nil)) ) pa (polar p2 (setq a (op (angle p2 (setq p3 (cadr sgC))) (/ pi 2.0))) dist) pb (polar p3 a dist) px1 (inters pa pb (car (car lstSg)) p2 nil) px2 (inters pa pb p3 (cadr (last lstSg)) nil) r (entmod (subst (cons 10 px1) (cons 10 p2) (entget (car se)))) r (entmod (subst (cons 10 px2) (cons 10 p3) (entget (car se)))) ) ) ) (princ "\nSelected object is not LWPOLYLINE....Exiting...") ) (princ) )4 points
-
This returns the serial number of the motherboard. It is more unique than the hard drive's serial number and also more unique than the variant of this same function that uses "Select * from Win32_BaseBoard". (defun obt_UUID (/ LObj SObj OSObj UUID) (setq LObj (vlax-create-object "WbemScripting.SWbemLocator") SObj (vlax-invoke LObj 'ConnectServer nil nil nil nil nil nil nil nil) OSObj (vlax-invoke SObj 'ExecQuery "SELECT UUID FROM Win32_ComputerSystemProduct") ) (vlax-for Obj OSObj (setq UUID (vlax-get Obj 'UUID)) ) (foreach Obj (list LObj SObj OSObj) (and Obj (vlax-release-object Obj)) ) UUID ) This might be a good option if you want your program to continue working when the user changes their hard drive but not their motherboard.3 points
-
I guess using GRREAD to pick a point in real time and behind the scenes do a search box looking for text and in particular a match say "ABC" in "ABCDEFGH" if yes then zoom in on that text. I am not good at GRREAD code so some one else may be able to help. Search box.part based on a pick point. (setq off 18) ; needs to be changed to suit a dwg. (while (setq pt (getpoint "\nPick point ")) (setq pt1 (polar pt (* 0.25 pi) off)) (setq pt2 (polar pt (* 0.75 pi) off)) (setq pt3(polar pt (* 1.25 pi) off)) (setq pt4 (polar pt (* 1.75 pi) off)) (setq pts (list pt1 pt2 pt3 pt4 pt1)) (setq ss (ssget "CP" pts '((0 . "TEXT")))) (if (= ss nil) (princ "\n nothing found ") (princ (strcat "\n" (cdr (assoc 1 (entget (ssname ss 0)))) " found")) ) )3 points
-
;| Adapted from an original idea by ElpanovEvgeniy 26.02.2010 https://www.theswamp.org/index.php?topic=30650.msg378483#msg378483 ******************* p o r d e s í a r g o ******************** ************************ G L A V C V S ************************* ************************** F E C I T *************************** |; (defun c:offSetea (/ se e pS c? c?c d dk r r1 pu p0 p1 p2 p3 o pt1 pt2 pt3 px1 px2 pa pb ct-r a42 op lgr bd fe *s* para asr dameCentroRadio erroria errores error0) (defun erroria () (defun errores (mens) (setq *error* error0) (entmod fe) (prin1) ) (setq error0 *error* *error* errores ) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (defun dameCentroRadio (pt1 pt2 a42 / d radio h aP th centro) (setq radio (/ (setq d (distance pt1 pt2)) (* 2 (sin (/ (setq th (* 4 (atan a42))) 2)))) ; Radio del arco h ((if (> (abs th) PI) - +) (sqrt (- (* radio radio) (* (/ d 2) (/ d 2))))); Distancia del centro al punto medio aP (+ (angle pt1 pt2) (* (/ pi 2) (if (> a42 0) 1 -1))) ; Ángulo perpendicular centro (list (+ (/ (+ (car pt1) (car pt2)) 2) (* h (cos aP))) (+ (/ (+ (cadr pt1) (cadr pt2)) 2) (* h (sin aP)))) ) (list centro radio) ; Devuelve centro y radio ) (erroria) (if (setq se (entsel "\nSelect LWPOLYLINE...")) (if (= (cdr (assoc 0 (entget (setq e (car se))))) "LWPOLYLINE") (progn (setq c? (= (vla-get-closed (setq o (vlax-ename->vla-object (setq e (car se))))) :vlax-true) c?c (equal (vlax-curve-getPointAtParam o (vlax-curve-getStartParam o)) (vlax-curve-getPointAtParam o (setq pu (vlax-curve-getEndParam o))) 1e-6) p1 (fix (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o (setq pS (cadr se))))) p2 (if (= p1 (1- pu)) (if c? 0 (1+ p1)) (1+ p1)) p0 (if (zerop p1) (if c? (1- pu)) (1- p1)) p3 (if (= p2 pu) (if (or c? c?c) 1) (1+ p2)) pt1 (vlax-curve-getPointAtParam o p1) pt2 (vlax-curve-getPointAtParam o p2) r (vlax-curve-getPointAtParam e (vlax-curve-getParamAtPoint o (vlax-curve-getClosestPointTo o pS))) pt0 (if p0 (vlax-curve-getPointAtParam o p0) (polar pt1 (+ (angle pt1 pt2) (/ PI 2.)) 100)) pt3 (if p3 (vlax-curve-getPointAtParam o p3) (polar pt2 (+ (angle pt1 pt2) (/ PI 2.)) 100)) a42 (cdr (assoc 42 (member (list 10 (car pt1) (cadr pt1)) (setq fe (entget e))))) ) (while (and (not para) (setq lgr (grread nil 13 0))) (if (or (member (cadr lgr) '(107 75)) (= (car lgr) 25) (not (listp (cadr lgr)))) (if (= (car lgr) 25) (setq para (entmod fe) bd T) (if (member (cadr lgr) '(107 75)) (setq *s* (not *s*)) ) ) (if (zerop a42) (setq d (distance (setq r1 (if *s* (progn (entmod fe) (setq para T dk (getreal "\nType the OFFSET distance (ENTER or RIGHT CLICK to indicate point on screen): ")) (getpoint r (if dk "\nSide to act on... " "\nPick a point on the screen... ")) ) (progn (prompt (strcat "\r " (if d (rtos d 2 3) "0.0") "...Press \'k\' to activate keyboard input...")) (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) ) (setq r (inters pt1 pt2 (polar r1 (setq a (+ (angle pt1 pt2) (/ PI 2.))) 3) (polar r1 (+ a PI) 3) nil)) ) px1 (inters pt0 pt1 (setq pa (polar pt1 (setq a ((asr pt1 r r1) (angle pt1 pt2) (/ pi 2.0))) (if dk dk d))) (setq pb (polar pt2 a (if dk dk d))) nil) px2 (inters pt2 pt3 pa pb nil) ) (setq ct-r (dameCentroRadio pt1 pt2 a42) d (- (distance (if *s* (progn (entmod fe) (setq para T dk (getreal "\nType the OFFSET distance (ENTER or RIGHT CLICK to indicate point on screen): ")) (getpoint r (if dk "\nSide to act on... " "\nPick a point on the screen... ")) ) (progn (prompt (strcat "\r " (if d (rtos (abs d) 2 3) "0.0") "...Press \'k\' to activate keyboard input...")) (cond ((= (car lgr) 5) (cadr lgr)) ((= (car lgr) 3) (setq para T) (cadr lgr)) ) ) ) (setq c (car ct-r)) ) (abs (cadr ct-r)) ) px1 (polar pt1 (angle (if (minusp d) pt1 c) (if (minusp d) c pt1)) (abs (if dk dk d))) px2 (polar pt2 (angle (if (minusp d) pt2 c) (if (minusp d) c pt2)) (abs (if dk dk d))) ) ) ) (if (not bd) (foreach l (list (list p1 (list (car px1) (cadr px1))) (list p2 (list (car px2) (cadr px2)))) (vla-put-coordinate o (car l) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray 5 '(0 . 1)) (cadr l)))) ) ) ) ) (alert "No LWPOLYLINE selected") ) (alert "NOTHING selected") ) (princ) ) One last small improvement that displays the cursor offset in real time (command line) during the first phase of the command. A very useful little feature, I think.3 points
-
Never stop thinking about problems, even when you are doing something outside.... Nice @GLAVCVS!3 points
-
@PGia I went out for my 40-50 km bike ride today and I've been thinking about this for a while. I tried OVERKILL-MR and I admit I wasn't able to figure out the right ranges to remove the excess without causing any damage to the rest of the drawing (perhaps someone can prove otherwise). For this reason, in my opinion, I think you should look for another solution. I assume your ultimate goal is to have a clean drawing on which to create a polygon topology. To do this, use '_mapclean' in C3D, activating the options in 'Cleanup Actions': - Delete duplicates - Erase short objects - Break crossing objects - Dissolve pseudonodes Repeat this 2 or 3 times. I don't think this will solve all the problems. But it will leave the drawing ready for you to try creating a polygon topology. The problematic polylines that remain in the drawing will appear with each attempt to create the topology. It's a laborious but safe process. I imagine you're confused because you suddenly have to do something you haven't done before. But I think you'll have no choice but to waste a little time learning.3 points
-
@NanGlase To further assess the possibilities of the "license server" option in real time from AutoCAD, the following needs to be considered: At the code level, you must: Check that both the client PC and your own have the same communication port available, and if not, handle this somehow. Also ensure that the firewall will not block the ports on either the client or the server side. At the infrastructure level, you must: Have a static IP or a domain name on the server side so that your code, when executed by the client, knows where to send the request. In my opinion, although this is an interesting challenge, you should assess whether the effort and investment required are justified by the benefits you may gain. I believe that, considering all of this, the most reasonable options might be those proposed by @Steven P and @BIGAL.2 points
-
Hi everyone, Semi-long time listener, first time caller. I wanted to say thanks for the help and tips I got from this site over the past 6 months. As I have been working on two autolisps, one called P0 the other P9. The do the same thing, kinda. P0 will pull the dwgname field and save it to the clipboard, allowing me to use it wherever without have to flip to the folders . . pick the file . . . hit F2 . . CTRL+C . . . then go back. P9 does the same thing, but adds dwgprefix + dwgname. I work in a third-party firm that uses several client projects with their different CAD standards. Some forbid using fields in the titleblocks for various reasons and like them hard coded. P9 is useful for when I'm jumping between sub-folders and need to plot to source folders. I can't use the PDFExport feature, as different clients use different standards and I need to make sure everything is good before going for each plot, mostly for peace of mind. I wanted to share these with you guys as a thank you and giving back to the community. My autolisps learning is only about 4 - 5 months old. FYI, I didn't know till literally a few days ago, from this very site, that one can right click the tab for the copy full path. lol P9.lsp P0.lsp2 points
-
Hi I’m attaching the code. But first, a brief explanation of how it works. The function is implemented by calling MiGRTexto with one parameter: the desired height for the real-time texts (this should be a value between 0.5 and 1) Therefore, it can be placed inside a main function that can be called from the command line (e.g., (defun c:myCommand)). As for the code that provides functionality, it's actually very simple: it consists of a text next to the right CROSSHAIR and an MTEXT below it. These must be properly managed so that they dynamically update their size, location and content—it's that straightforward. From there, it’s just a matter of adding code to achieve whatever final functionality the user needs. In the attached code, a small emulator for the "pline" command is implemented, triggered by a LEFT CLICK event. This event calls funcionPrincipal, which is provided with two arguments: the screen point indicated and the entity name (or nil) of the object under the PICKBOX at that location. These two arguments should be enough to enable any subsequent operation. It’s important to note that the entire behavior relies on GRREAD, and therefore on mouse and keyboard events. These events are handled using several clauses within a cond expression, which can be extended or modified by the user. I haven’t implemented any code to add object snap functionality. Doing so would considerably complicate the code, and for some users, it may not be necessary. In any case, suggestions and improvements (regarding snapping or any other proposals) are welcome in this thread—for those (myself included) who may want to improve or add new features. I won’t go on any further. Now, the code... ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun MiGRTexto (factor / l se e le txTmp txTmp1 txOk tam p pa pt pt1 i? v1 polil alt tx para erroria errores error0 textoGR1 textoGR2 funcionPrincipal) (defun erroria () (defun errores (mens) (setq *error* error0) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (prin1) ) (setq error0 *error* *error* errores ) ) (defun funcionPrincipal (pt e) (setvar 'LASTPOINT pt) ;;;INICIO(START) EMULAD(T)OR "pline" (if polil (entmod (append (entget polil) (list (cons 10 pt)))) (if (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 8 "0") (cons 90 2) '(70 . 128) '(62 . 256) (cons 10 pa) (cons 10 pt) ) ) (setq polil (entlast)) ) ) (setq pa pt) ;;;FIN(END) EMULAD(T)OR "pline" ) (defun textoGR1 () ;THIS FUNCTION RETURN TEXT STRING TO DISPLAY ABOVE CURSOR. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE EL TEXTO A MOSTRAR SOBRE EL CURSOR. MIDIFÍCALA SEGÚN LO NECESITES (rtos (distance (getvar 'LASTPOINT) p) 2 3) ) (defun textoGR2 (lp / lp MT) ;ESTA FUNCIÓN DA EL FORMATO NECESARIO AL MTEXT QUE SE MOSTRARÁ BAJO EL CURSOR (foreach l lp (if MT (setq MT (strcat MT (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) (setq MT (strcat (car l) " {\\fLucida Sans Unicode|b0|i0|c0|p34;\\C4;" (cadr l) "}")) ) (setq MT (if (equal l (last lp)) MT (strcat MT "\\P"))) ) ) (defun dameGRT2 (le / cl to) ;THIS FUNCTION RETURN THE LIST OF PAIRS THAT textoGR2 NEEDS TO FORMAT CONTENTS OF MTEXT. ADJUST IT TO SUIT YOUR NEEDS ;ESTA FUNCIÓN DEVUELVE LA LISTA DE PARES QUE NECESITA textoGR2 PARA GENERAR LA CADENA DE TEXTO QUE NECESITA EL MTEXT (list (list "Object" (setq to (cdr (assoc 0 le)))) (list "Layer" (cdr (assoc 8 le))) (list "Color" (if (setq cl (cdr (assoc 62 le))) (itoa cl) "BYLAYER")) (list "XData?" (if (assoc -3 le) "YES" "NO")) ) ) (erroria) (setq txTmp (vla-AddText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) "0" (VLAX-3D-POINT '(0 0)) 0.1) txTmp1 (vla-AddMText (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0)) 5000 "0") i? T ) (vla-put-color txTmp 1) (vla-put-visible txTmp 0) (vla-put-color txTmp1 2) (vla-put-visible txTmp1 0) (while (and (not para) (setq l (grread nil 13 0))) (setq tam (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 2 factor ) ) (if e (redraw e 4)) (setq e (if (setq se (if (listp (setq p (cadr l))) (nentselp p))) (if (and (not (member (vlax-ename->vla-object (car se)) (list txTmp txTmp1))) (member (cdr (assoc 0 (setq le (entget (car se) '("*"))))) '("LWPOLYLINE" "POLYLINE" "LINE" "SHAPE" "3DFACE" "INSERT" "TEXT" "MTEXT" "ATTRIB") ) ) (car se) ) ) ) (if (and i? e) (vla-put-visible txTmp1 1) (vla-put-visible txTmp1 0)) (prompt (strcat "\rLWPOLYLINE mode: " (if pa "next" "first") " point... (Press \'F10\' for " (if i? "DEACTIVATE" "ACTIVATE") " real-time reporting)")) (cond ((= (car l) 5) (if (not v1) (setq v1 (vla-put-visible txTmp 1) v1 T)) (setq pt (list (+ (car p) (* tam 0.8)) (+ (cadr p) (/ tam 2.2)))) (redraw) (if pa (grvecs (list 7 pa p))); THIS LINE IS PART OF THE "pline" EMULATOR CODE. DISABLE IT IF YOU DONT WANT TO USE THE EMULATOR IMPLEMENTED IN funcionPrincipal ; ESTA LINEA FORMA PARTE DEL EMULADOR "pline". DESACTIVALO SI ELIMINAS EL CÓDIGO EMULADOR IMPLEMENTADO EN funcionPrincipal (vlax-put-property txTmp 'InsertionPoint (vlax-make-variant (vlax-3d-point pt))) (vlax-put txTmp 'Height tam) (vlax-put txTmp 'TextString (textoGR1));<<<-- MODIFICAR ESTA LINEA DE CÓDIGO PARA QUE 'TextString MUESTRE EL TEXTO DESEADO (if (and i? e) (progn (redraw e 3) (setq pt1 (list (car pt) (- (cadr p) (/ tam 2.)))) (vlax-put-property txTmp1 'InsertionPoint (vlax-make-variant (vlax-3d-point pt1))) (vlax-put txTmp1 'Height tam) (vlax-put txTmp1 'TextString (textoGR2 (dameGRT2 le))) ) ) ) ((= (car l) 3) (if pa (funcionPrincipal p (car se)) (setq pa p))); ((= (car l) 25) (setq para T)); BOTON DERECHO = SALIR ((member (cadr l) '(67 99)) (if polil (setq para (entmod (subst (cons 70 1) (assoc 70 (entget polil)) (entget polil)))))); ((= (cadr l) 21) (setq i? (not i?))) ;;; AQUI DEBAJO EL CODIGO PARA GESTIONAR EL RESTO DE OPCIONES ;;; BELOW YOU CAN ADD MORE CLAUSES TO 'cond' TO EXTEND THE CODE FUNCTIONALITY (T ;REST OF CASES: WE DO NOTHING ) ;| .... .... |; ) ) (vla-delete txTmp) (vla-delete txTmp1) (redraw) (if e (redraw e 4)) (princ) )2 points
-
Forgive the Python, only trying to illustrate one possibility. This code creates a spatial filter for a block reference, to simulate a detail. In the image, I created a block of the room, with two references. One has a spatial filter applied and is scaled. You can do the same in lisp, or by hand, make a copy of the block, run the xclip command, draw your polyline perimeter, set XCLIPFRAME to 1 so you can see your frame. instead of a circle, use a polygon with a shape to your liking. My code still needs work as my transformby is wonky(not centered correctly) and I hand drew the leader line lol import traceback from pyrx import Rx, Ge, Gi, Db, Ap, Ed ACDB_INFINITE_XCLIP_DEPTH = 1.0e300 def addFilter_getmat(refid, filter): ref = Db.BlockReference(refid, Db.OpenMode.kForWrite) Db.IndexFilterManager.addFilter(ref, filter) return ref.blockTransform() @Ap.Command() def doit(): try: db = Db.curDb() _ps, refid, _ = Ed.Editor.entSel("\nSelect ", Db.BlockReference.desc()) _ps, cen = Ed.Editor.getPoint("\nGet center: ") _ps, rad = Ed.Editor.getDist(cen, "\nGet radius: ") carc = Ge.CircArc3d(cen, Ge.Vector3d.kZAxis, rad) pts3d, _params = carc.getSamplePoints(20) filter = Db.SpatialFilter() mat = addFilter_getmat(refid, filter) pts2d = [] for pt in pts3d: pt.transformBy(mat) pts2d.append(Ge.Point2d(pt.x, pt.y)) filter.setDefinition( pts2d, Ge.Vector3d.kZAxis, db.elevation(), ACDB_INFINITE_XCLIP_DEPTH, -ACDB_INFINITE_XCLIP_DEPTH, True, ) except Exception as err: print(err)2 points
-
2 points
-
Easy enough to solve. The easiest way is to just use a viewport in a layout, but you can lead a horse to water...2 points
-
Not lisp, One approach would be to use a point monitor https://www.cadtutor.net/forum/topic/98349-use-a-point-monitor-to-add-items-to-the-hover-tooltip/ A draw jig might be also work depending on the context.2 points
-
[Advanced] Use a point monitor to add items to the hover tooltip import traceback from pyrx import Rx, Ge, Gi, Db, Ap, Ed print("added command pymon") print("added command pyunmon") # Adds the monitors to the application def OnPyInitApp(): PyRxCmd_pymon() def OnPyUnloadApp(): PyRxCmd_pyunmon() # https://help.autodesk.com/view/OARX/2025/ENU/?guid=GUID-BBDA79D3-A509-4C96-966E-72592BD32ACD class MyPointMonitor(Ed.InputPointMonitor): def __init__(self): Ed.InputPointMonitor.__init__(self) def monitorInputPoint(self, input: Ed.InputPoint, output: Ed.InputPointMonitorResult): try: ents = input.pickedEntities() geo: Gi.Geometry = input.drawContext().geometry() if len(ents) == 0: geo.text(input.rawPoint(), Ge.Vector3d.kZAxis, Ge.Vector3d.kXAxis, 10.0, 1.0, 0, "Cold") output.setAdditionalTooltipString("COLD") else: geo.text(input.rawPoint(), Ge.Vector3d.kZAxis, Ge.Vector3d.kXAxis, 10.0, 1.0, 0, "Hot") output.setAdditionalTooltipString("HOT") except Exception as err: print(err) # global space pm = MyPointMonitor() def PyRxCmd_pymon(): try: manager = Ap.curDoc().inputPointManager() manager.addPointMonitor(pm) except Exception as err: print(err) def PyRxCmd_pyunmon(): try: manager = Ap.curDoc().inputPointManager() manager.removePointMonitor(pm) except Exception as err: print(err) Screen Recording 2025-06-20 102115.mp42 points
-
This might be a starting point https://www.lee-mac.com/grtext.html combine BIGAL and demo one?2 points
-
*s* remains for the future as a small device abandoned on the moon that, perhaps one day, will be used by the next visitor.2 points
-
Hi @pkenewell I don’t use tangents. For straight segments, the geometry progresses or retreats based on the angular direction of the lateral segments of the selected one. For arc segments, in order to “link” them, progression and retreat are done based on the radius. The variable *s* is currently single-use if passed to the second part of the command, outside of GRREAD. The code is like a living being: it’s born with the idea of following a path, and along the way, it chooses a different route. So *s* was implemented with the intention of providing a complete solution within GRREAD, and along the way, the current solution was chosen instead.2 points
-
Maybe something like this will help you: .................... (setq ename (car (entsel)) edata (entget ename '("*")) data (cdr (assoc -3 edata)) ) (foreach memb data (setq nlst (cons -3 (list (cons (car memb) nil)))) (setq ndata (subst nlst (assoc -3 edata) edata)) (entmod ndata) ) ....................2 points
-
"scale of 100 for a table in the code?" work out the correct scale value and just adjust the table. You know the default size of say text height and can work out what you want as text height at 1:100.2 points
-
@Steven P went around in circles but false/true is only half of answer this helped ; UnmergeCells minRow, maxRow, minCol, maxCol (vla-unMergeCells table 0 0 0 1) Even though no Title it was still merged cells.2 points
-
A potentially more viable option, in terms of the plausibility of the resulting curve, would be to obtain a dense list of points from the arcs to be modified, recalculate them using the requested parameters, and create a spline fitted to those points.2 points
-
@andyb57J Here's another way to do it using entmakex. I hardcoded the 'STAGE' prefix: (defun c:cnl (/ cnt el i la llst ss) (if (and (setq ss (ssget)) (> (setq i (getint "\nEnter number of stages: ")) 0)) (progn (repeat (setq cnt (sslength ss)) (setq el (entget (ssname ss (setq cnt (1- cnt)))) la (cdr (assoc 8 el)) ) (or (member la llst) (setq llst (cons la llst))) ) (foreach n llst (setq cnt 0) (repeat i (setq el (entget (tblobjname "LAYER" n) '("*"))) (entmakex (subst (cons 2 (strcat "STAGE " (itoa (setq cnt (1+ cnt))) "_" n)) (assoc 2 el) el) ) ) ) ) ) (princ) )2 points
-
If you also want to change the lines, add (vla-put-ExtensionLineColor obj 1) (vla-put-DimensionLineColor obj 1)2 points
-
You can use this to write to Excel Note not supported in LT24+. Dont have Excel open, just write to the cell using row and column rather than write to a csv. ;; Thanks to fixo ;; ;; = Set Excel cell text = ;; ;; ;; (defun xlsetcelltext ( row column text) (setq cells (vlax-get-property (vlax-get-property myxl "ActiveSheet") "Cells")) (vl-catch-all-apply 'vlax-put-property (list cells 'Item row column (vlax-make-variant (vl-princ-to-string text) vlax-vbstring))) ) ;; Try to get or create Excel instance (setq myxl (vl-catch-all-apply 'vlax-get-or-create-object '("Excel.Application"))) (if (vl-catch-all-error-p myxl) (progn (prompt "\nError: Could not start Excel.") (exit) ) ) (if (= (vlax-get-property (vlax-get-property myXL 'WorkBooks) 'count) 0) (vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add) ) (vla-put-visible myXL :vlax-true) (vlax-put-property myxl 'ScreenUpdating :vlax-true) (vlax-put-property myXL 'DisplayAlerts :vlax-true)2 points
-
Korean, I know because I watch kpop2 points
-
@GoldSA, Try this code: (prompt "\nTo run a LISP type: COMTXTCSV") (princ) (defun c:COMTXTCSV ( / old_snap ss len i lst file op minPt maxPt ssn lst elast ptlist) (setq old_osnap (getvar 'osmode)) (setvar 'osmode 0) (prompt "\nSelect TEXT or MTEXT:") (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1))) len (sslength ss) i 0 lst (list) ) (setq file (getfiled "Choose file save destination" "" "csv" 1) op (open file "w") ) (while (< i len) (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt) (setq minPt (vlax-safearray->list minPt) maxPt (vlax-safearray->list maxPt) ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>"))) lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst) ) (if (= ssn nil) (progn (command-s "_RECTANG" minPt maxPt) (setq elast (entlast) ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget elast))) ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>"))) lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst) ) ) ) (setq i (1+ i)) ) (foreach val lst (write-line (strcat (car val) "," (cadr val)) op) ) (close op) (setvar 'osmode old_osnap) (prompt (strcat "\nThe text values are written in " (vl-filename-base file) ".csv!")) (princ) ) Two things to note: - the firtst one is inside this part of code "(setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1)))", (cons 8 "?????")", the question marks present the red text values (I can't read the layer name, it is on chineese, but doesn't make a problem for me to performe COMTXTCSV) (picture 1). If the layer name is differnt, you need to put a right name for the layer name inside (cons 8 "?????"), which is the inside "(setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1)))"". - the second one is inside this part of code "ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))" and this part of code "ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))", if the layer name is different than "TEXT" inside the "(cons 8 "TEXT")", you need to replace into the correct layer name, and for the "TEXT COLOR" inside the "(cons 62 4)", you also need to replace into the correct color index (picture 2). After executing the COMTXTCSV command, I get this (picture 3): Best regards.2 points
-
Have you started a new post based on one you already had ? No need for that.2 points
-
@BIGAL Has a really nice multi-radio button routine that looks like it would work.1 point
-
@Steven P That is a good academic exercise to learn from, but the OP did not want to scale all the location coordinates of the text. He wanted the X and Y straight from the text location without scaling, then using the VALUE in the text to get the Z coordinate multiplied by 1000 (Meters to Millimeters). I.e. if the text object is located at X=1200, Y=700, and the Value in the text is "10.4", the point would be located at X=1200, Y=700, and Z=10400.1 point
-
That's no problem - if it helps everyone out then all is good.1 point
-
Your not very clear on what you want. You might also mention what you want to do with the selection. I hope @Steven P doesn't mind, I adapted his code to type in the search parameters. See if this is what you want? ;;; Select all the matching texts/mtexts of the file at the same time. ;;; ;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/#findComment-671522 ;;; ;;; By Steven P ;;; ;;; SLW210 (a.k.a. Steve Wilson) Changed original to add typed in selection for search. ;;; ;;; https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/page/2/#findComment-672082 ;;; (defun c:SATM ( / MyEnt MyText MySS FinalSS acount EntData txtString ) ;; Prompt for search string instead of selecting a MTEXT entity (setq MyText (getstring T "\nEnter text to search for: ")) ;; Select all TEXT and MTEXT entities in the drawing (setq MySS (ssget "X" '((0 . "TEXT,MTEXT")))) ;; Create an empty selection set for matched entities (setq FinalSS (ssadd)) (setq acount 0) ;; Loop through all entities and match their text content (while (< acount (sslength MySS)) (setq MyEnt (ssname MySS acount)) (setq EntData (entget MyEnt)) (setq txtString (strcase (cond ((cdr (assoc 1 EntData))) ; TEXT or MTEXT first part ((cdr (assoc 3 EntData))) ; Additional MTEXT ))) (if (and txtString (wcmatch txtString (strcat "*" (strcase MyText) "*"))) (setq FinalSS (ssadd MyEnt FinalSS)) ) (setq acount (1+ acount)) ) ;; Optional: highlight matching entities (if (> (sslength FinalSS) 0) (progn (sssetfirst nil FinalSS) (princ (strcat "\nFound " (itoa (sslength FinalSS)) " matching entities.")) ) (princ "\nNo matching text found.") ) ;; do what you want here with found texts (princ) )1 point
-
@pkenewell thank you for that, it works perfectly.... One day i will understand how lisp language works, then i will retire and never use it again1 point
-
You're welcome @GoldSA, glad it works.1 point
-
Thank you for correction Sorry @GoldSA. Hm, the third season of the squid game will burn1 point
-
It is the same as doit.xlsx file which are posted by @Danielm103, but with chinees letters.1 point
-
@GoldSA Try this modified code: (prompt "\nTo run a LISP type: COMTXTCSV") (princ) (defun c:COMTXTCSV ( / old_snap ss len i lst file op minPt maxPt ssn lst elast ptlist) (setq old_osnap (getvar 'osmode)) (setvar 'osmode 0) (prompt "\nSelect TEXT or MTEXT:") (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????"))) ;; (cons 62 1) len (sslength ss) i 0 lst (list) ) (setq file (getfiled "Choose file save destination" "" "csv" 1) op (open file "w") ) (while (< i len) (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt) (setq minPt (vlax-safearray->list minPt) maxPt (vlax-safearray->list maxPt) ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons 8 "TEXT"))) ;; (cons 62 4) ) (if (/= ssn nil) (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst)) (progn (command-s "_RECTANG" minPt maxPt) (setq elast (entlast) ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget elast))) ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons 8 "TEXT"))) ;; (cons 62 4) ) (if (/= ssn nil) (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst)) ) ) ) (setq i (1+ i)) ) (foreach val lst (write-line (strcat (car val) "," (cadr val)) op) ) (close op) (setvar 'osmode old_osnap) (prompt (strcat "\nThe text values are written in " (vl-filename-base file) ".csv!")) (princ) ) After executing the modified code, I get this (chinees letters transformed into to the unicod chars, doesn't going to be problem for you): Best regards.1 point
-
I used python and a KDTree to pair up the texts There was challenge over at the swamp pairing a line with text https://www.theswamp.org/index.php?topic=59487.0 Could be a source of inspiration for pairing up text items. The fastest is using a language with a KDTree, for lisp, Lee Mac’s code was pretty impressive https://www.theswamp.org/index.php?topic=59487.msg620760#msg6207601 point
-
like this?doit.xlsx1 point
-
1 point
-
What you show in the image is different to what people think you want. Need a sample dwg. The way to go may be look for the red text by layer and then is any other text touching. Join the 2 answers and post to Excel. The to Excel can be done directly. Post sample dwg.1 point
-
1 point
-
I merged your threads into the original.1 point
-
Purely an issue with which options you choose. They are not necessarily side effects.1 point
-
Do you want to sort the entities by their display order (with the bottommost entity first and the topmost last)? Or do you want to sort them alphabetically by text content?1 point
-
In short: You need the point to be transformed to be referenced to an official reference system: UTM WGS84, ETRS89, etc., and you also need to know the geographic zone it's in. Therefore, if your point isn't in an official reference system and you don't have transformation parameters, your first task is to find a way to relate them.1 point
-
Converting a X y to a lat & long is not just use some formula, yes you use a formula but it has all sorts of values in it depending on where you are in the world. As you go around the world you have zones and these are relevant to where you live. There is formulas out there so google, or if you use CIV3D you can adopt a world zone and display Lat & Long's as a point style.1 point
-
So a wildcard - caractere generique - is a modifier added to some text that some functions use to do other things. In this case '*' is a wild card meaning any other characters, a string of characters or non at all: "*text" will find 'Text' and also 'mtext'. Here is a better (English Language) description than I can write with the different wildcards listed https://help.autodesk.com/view/OARX/2023/ENU/?guid=GUID-EC257AF7-72D4-4B38-99B6-9B09952A53AD In my examples above you can generally replace 'mtext' with '*text' to select both forms (and also rtext which is rarely used I think) For example (setq MySS (ssget (list (cons 0 "MTEXT")(cons 1 (strcat "*" MyText "*"))))) Can be to capture both types of text (setq MySS (ssget (list (cons 0 "*TEXT")(cons 1 (strcat "*" MyText "*"))))) To automatically select all the texts in the page you can change (ssget (list (.... or (ssget '(( to add a modifier to the function, for everything add '_X' (setq MySS (ssget "_X" (list (cons 0 "*TEXT")(cons 1 (strcat "*" MyText "*"))))) Again a link with a better description and more modfiers: https://lee-mac.com/ssget.html1 point
-
1 point