Jump to content

Leaderboard

  1. GLAVCVS

    GLAVCVS

    Community Member


    • Points

      58

    • Posts

      654


  2. BIGAL

    BIGAL

    Trusted Member


    • Points

      37

    • Posts

      19,646


  3. SLW210

    SLW210

    Moderator


    • Points

      17

    • Posts

      11,242


  4. Saxlle

    Saxlle

    Community Member


    • Points

      15

    • Posts

      183


Popular Content

Showing content with the highest reputation since 06/04/2025 in all areas

  1. 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.
    7 points
  2. https://www.theswamp.org/index.php?topic=30650.msg378483#msg378483
    4 points
  3. 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
  4. 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) )
    3 points
  5. 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
  6. 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
  7. ;| 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
  8. LT does support ActiveX/COM, but cannot interface with objects outside of the AutoCAD Object Model.
    2 points
  9. @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
  10. 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.lsp
    2 points
  11. 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
  12. pretty slick! you made a Jig in lisp
    2 points
  13. 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
  14. 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
  15. [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.mp4
    2 points
  16. This might be a starting point https://www.lee-mac.com/grtext.html combine BIGAL and demo one?
    2 points
  17. *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
  18. 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
  19. 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
  20. "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
  21. @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
  22. 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
  23. @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
  24. If you also want to change the lines, add (vla-put-ExtensionLineColor obj 1) (vla-put-DimensionLineColor obj 1)
    2 points
  25. 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
  26. @Steven P ok . Upload 2D layout drawing with about 40 blocks
    1 point
  27. Thankyou. This is perfect. Only thing I would add is an underscore after the Stage no. I have addressed your other queries to provide the results but can't wok out where to put the underscore so it appears after the stage no. This lisp will most likely only be used to create the stage no layers so the prefix and suffix part will not be required. If I need those, I still have the original lisp.
    1 point
  28. Try changing vla-put-color to vla-put-textColor
    1 point
  29. You might need to post a sample drawing, perhaps a before and after too This is what I got with a quick check:
    1 point
  30. Hi Nikon It's probably because the text color in the dimension style is set to "bylayer."
    1 point
  31. Your x & y vector lists are constructed incorrectly.
    1 point
  32. This tutorial may also be of interest.
    1 point
  33. PS: The option to measure the offset distance with the cursor will always be calculated orthogonally with respect to the vector defined by the selected segment It is also possible that I have forgotten to include some of the variables in the list of local variables: this is a small job that I leave for whoever wants to use this code.
    1 point
  34. So the real approach is to find the closest segment and define, at the intersection on it, the angle closest possible to those 45º
    1 point
  35. This link does this but it asks for an area instead of a length
    1 point
  36. Hi I have something that works fine with straight segments, but fails if the picked segment or the connected ones are bulged. It uses grread with a rudimentary osnap implementation and it just allow picking points, you can't specify offset distance.
    1 point
  37. Why not the old OFFSET command ? Command: _offset Current settings: Erase source=No Layer=Source OFFSETGAPTYPE=0 Specify offset distance or [Through/Erase/Layer] <Through>: Specify second point: Select object to offset or [Exit/Undo] <Exit>: Specify point on side to offset or [Exit/Multiple/Undo] <Exit>: Select object to offset or [Exit/Undo] <Exit>: *Cancel* Command: Offset at taper by offset command-Model.pdf Offset at taper by offset command.dwg
    1 point
  38. If the sides are parallel, you could set the UCS to them and stretch with ortho on. Too simple?
    1 point
  39. I would try to use the lisp as it is. Convert all the points to a block and change the scale in Z dirrection. ...not tested...
    1 point
  40. Here is multi radio buttons single row or column and a 2column version. Instructions are in the top of the code. You just need to save the multi lsp's into a support path or use full path when doing the (load From the code (if (not AH:Butts)(load "Multi Radio buttons.lsp")) (if (= but nil)(setq but 1)) (setq ans (atoi(ah:butts but "V" '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")))) ; ans holds the button picked as an integer value I wont go into it now but you can convert the dcl code made into lsp code. So don't need the multi radio.lsp. Ps Multi Toggles & Multi getvals also available.
    1 point
  41. @SLW210Just a comment I use my Multi toggles.lsp to write the dcl code. so need about 3 lines of code to do all the dcl toggle. The answer is returned as a list of (0 1 1 0 1 1 0) etc meaning the toggle is on or off then compare that to your variables as an example (nth 0 ans) = 1 so search = (nth 0 lst) else is nil. I also use the RLX convert dcl to lisp.lsp so just edit the multi toggles.lsp to write to a file it saves a lot of typing, then use the RLX convert and it makes the code for insertion into your lisp. Saves typo's. .Multi toggles.lsp
    1 point
  42. @BIGAL Has a really nice multi-radio button routine that looks like it would work.
    1 point
  43. @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
  44. That's no problem - if it helps everyone out then all is good.
    1 point
  45. 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
  46. @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 again
    1 point
  47. 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.html
    1 point
  48. Add a checklayer defun before setting the current layer. This includes color and linetype. (defun chklay (lay col lt / ) (if(not(tblsearch "LAYER" lay)) (command "-layer" "m" lay "c" col lay "lt" lt lay "") (princ "exist") ) (setvar 'clayer lay) ) For me I use a dcl for questions. If you want it ask.
    1 point
  49. An interesting feature is that if you select a text like L1, the numbering continues to L9, then comes M0...M9, etc.
    1 point
×
×
  • Create New...