All Activity
- Today
-
thekiki started following Exit the command with the right mouse button in one click
-
Exit the command with the right mouse button in one click
thekiki replied to Nikon's topic in AutoLISP, Visual LISP & DCL
Hi all, Is there a possibility to select multiple text at once. Thanks for your answer. -
Hello thank you for your reply. May be I did not explain properly what I want to do. I will post some pictures may be they will help. On the Block_1.jpg is how the drawing has to look like. On the Block_2.jpg is the block it self when is edited. So the script has to change "Angle" and "Angle1" so the so called arrows point to the previous and next block - Block_3.jpg
-
Exit the command with the right mouse button in one click
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
@GLAVCVS thank you very much for the 2 options, I like both options, but the first option suits me better. -
Exit the command with the right mouse button in one click
GLAVCVS replied to Nikon's topic in AutoLISP, Visual LISP & DCL
If you don't want the command to end after editing the text, you can keep the "while" loop, as shown in this other code. The operation will be the same except that to exit the command, you'll need an additional "right click." (defun c:TEcolor136_230 (/ error oldcmdecho sel e typo obj res currentColor para) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho) ) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat "Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (while (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ")) (setq ;sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ") e (car sel) typo (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch typo "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (getstring) (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e "")) ) ;;; (if (/= (setq res (getstring (strcat "\nEdit text <" (cdr (assoc 1 (entget e))) ">: "))) "") ;;; (entmod (subst (cons 1 res) (assoc 1 (entget e)) (entget e))) ;;; ) (if (vl-catch-all-error-p res) (princ "Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230) ) ) (princ "Couldn't change color to 230.") (princ "The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136) ) ) (princ "Couldn't change the color to 136.") (princ "The color has been changed to 136.") ) ) (princ "Editing completed.") ) ) ) (princ "It's not an object TEXT/MTEXT.") ) ) (setvar "CMDECHO" oldcmdecho) (princ) ) -
Exit the command with the right mouse button in one click
GLAVCVS replied to Nikon's topic in AutoLISP, Visual LISP & DCL
I hope the 'textedit' options in your version of AutoCAD aren't a problem. -
Exit the command with the right mouse button in one click
GLAVCVS replied to Nikon's topic in AutoLISP, Visual LISP & DCL
There's another option: to respect the call to 'textedit' and exit it by clicking the mouse over the empty background. This is the option applied in the attached code. (defun c:TEcolor136_230 (/ error oldcmdecho sel e typo obj res currentColor para) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho) ) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat "Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) ;;; (while (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ")) (setq sel (entsel "\nSelect TEXT/MTEXT to edit (Enter — exit): ") e (car sel) typo (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch typo "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (getstring) (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e "")) ) ;;; (if (/= (setq res (getstring (strcat "\nEdit text <" (cdr (assoc 1 (entget e))) ">: "))) "") ;;; (entmod (subst (cons 1 res) (assoc 1 (entget e)) (entget e))) ;;; ) (if (vl-catch-all-error-p res) (princ "Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230) ) ) (princ "Couldn't change color to 230.") (princ "The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136) ) ) (princ "Couldn't change the color to 136.") (princ "The color has been changed to 136.") ) ) (princ "Editing completed.") ) ) ) (princ "It's not an object TEXT/MTEXT.") ) ;;; ) (setvar "CMDECHO" oldcmdecho) (princ) ) -
Exit the command with the right mouse button in one click
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
That's fine with me... -
Exit the command with the right mouse button in one click
GLAVCVS replied to Nikon's topic in AutoLISP, Visual LISP & DCL
I think you need one ENTER to exit from 'textedit' and another one to exit from the while loop. I think It’s not possible to solve everything with a right click. The only option that comes close to what you’re asking for is to remove the while loop, so that the command ends after editing each text. But this will force you to press right click to repeat the command. The only option that would allow what you’re describing is to edit the text content with getstring instead of textedit. But I don’t know if you’re willing to do that. -
Help: Section Line for Architecture Drawings
mhy3sx replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
Thanks Saxlle. Works fine -
Saxlle started following Help: Section Line for Architecture Drawings
-
Help: Section Line for Architecture Drawings
Saxlle replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
@mhy3sx Try the following code (it work the same as yours, but you can see the part of code for "letter" roration for your part of code, you can get a text angle when creating an arrow): (prompt "\nTo run a LISP type: SECLINE") (princ) (defun c:SECLINE ( / old_osmode flag alphabet dist arrow_base arrow_height text_height spt ept output base_pt ang off_pt arrow_ang arrow_fpt arrow_spt arrow_midpt arrow_tpt letter_ang letter_inspt answ) (setq old_osmode (getvar 'osmode)) (setvar 'osmode 0) (setq flag T alphabet (list "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z") ;; Alphabet UPPERCASE letters dist 0.11 ;; offset distance from section line arrow_base 0.69 arrow_height 0.27 text_height 0.27 ) (if (not (tblsearch "layer" "Section")) (command-s "_layer" "_m" "Section" "_c" "10" "" "_lw" "0.05" "" "") (setvar 'clayer "Section") ) (while (= flag T) (setq spt (getpoint "\nPick the first point:") ept (getpoint spt "\nPick the second point:") ) (command-s "_UNDO" "begin") (entmake (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 100 "AcDbLine") (cons 8 (getvar 'clayer)) (cons 10 spt) (cons 11 ept))) (initget 1 (car alphabet)) (setq output (getkword (strcat "\nChoose a letter from the list [" (vl-string-translate " " "/" (car alphabet)) "]: "))) (setq base_pt ept ang (angle spt ept) off_pt (getpoint base_pt "\nPick the side to get an arrow and letter") arrow_ang (angle base_pt off_pt) ) ;; 1. arrow and text (setq arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) ;; 2. arrow and text (setq base_pt spt ang (angle ept spt) arrow_fpt (polar base_pt arrow_ang dist) arrow_spt (polar arrow_fpt ang (- arrow_base)) arrow_midpt (mapcar '* (mapcar '+ arrow_fpt arrow_spt) (list 0.50 0.50)) arrow_tpt (polar arrow_midpt arrow_ang arrow_height) letter_ang (angle arrow_fpt base_pt) letter_inspt (polar arrow_midpt letter_ang (* arrow_height 1.15)) letter_ang (+ pi (/ pi 2) arrow_ang) ) (entmake (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 100 "AcDbTrace") (cons 10 arrow_fpt) (cons 11 arrow_spt) (cons 8 (getvar 'clayer)) (cons 12 arrow_tpt) (cons 13 arrow_tpt))) (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 letter_inspt) (cons 8 (getvar 'clayer)) (cons 40 text_height) (cons 1 output) (cons 50 letter_ang) (cons 72 1) (cons 73 2) (cons 11 letter_inspt))) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\nDo you want to continue or Undo? [Yes/No/Undo]")) (cond ((= answ "No") (setq flag nil) ) ((= answ "Undo") (command-s "_UNDO" "") ) ) (princ) ) (setvar 'osmode old_osmode) (prompt "\nDrawing section lines are done!") (princ) ) This is the short video example. SectionLine.mp4 Best regards. - Yesterday
-
For a client did draw arrows I used a entmake pline so have control over the arrow sizes length and width. Its a case of setting the start as 0.0 and a length and an end arrow width. Yes matching angle of a pline and same layer. Can you provide more information about how the arrows are to be shown at each vertice, length and width plus direction.
-
Help: Section Line for Architecture Drawings
BIGAL replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
@mhy3sx Does parametrics exist in ZWCAD ? If so what happens if you edit the example I posted just use Bedit and remove the circles and add your section mark details and save block edits. There should be a stretch option for parametrics. These are blocks and matching code just does a mirror. Just an example of choose type of mark using a pop menu. -
Exit the command with the right mouse button in one click
BIGAL replied to Nikon's topic in AutoLISP, Visual LISP & DCL
Why not check the color 1st change the color then edit it ? Also you can shorten the get put property. Must be a vl object. (setq colorobj (vlax-get obj 'color)) (vlax-put obj 'color 230) Maybe this also ;; If it's 136, change it to 230. (if (= currentColor 136) (vlax-put obj 'color 230) (vlax-put obj 'color 130) ) To select only *text you can use a ssget (while (setq ss (ssget '(( 0 . "*TEXT")))) (setq e (ssname ss 0)) (setq obj (vlax-ename->vla-object e)) Have a look at Lee-mac SSGET functions look at the E: option. -
Maybe it's just that property doesn't exist on the specified object.
-
Did you try this ? https://www.cadtutor.net/forum/topic/76319-add-block-onto-polyline-vertices/
-
Help: Section Line for Architecture Drawings
mhy3sx replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
Now the arrows is correct. The only problem is the angle of the text is not in all direction in correct angle !!! I want the text to have the same directions with the arrows (defun C:SECTIONLINE ( / pt1 pt2 dirpt secLet baseAngle dx dy cross normalAngle arrowBase arrowHeight arrowOffset offset letterOffset arrow1Base arrow2Base center1 center2 txtpt1 txtpt2 angleGrad) (setq arrowBase 0.69) (setq arrowHeight 0.27) (setq arrowOffset 0.345) (setq offset 0.11) (setq letterOffset 0.42) (command "._STYLE" "Section" "Arial" 0.0 1.4 0 "N" "N" "N") (if (not (tblsearch "layer" "Section")) (command "_-layer" "make" "Section" "color" "10" "" "lw" "0.05" "" "") ) (setvar "clayer" "Section") (setq pt1 (getpoint "\nSelect first point of section line: ")) (if (not pt1) (progn (princ "\nCanceled.") (exit))) (setq pt2 (getpoint pt1 "\nSelect second point of section line: ")) (if (not pt2) (progn (princ "\nCanceled.") (exit))) (setq dirpt (getpoint "\nPick a point to define section direction: ")) (if (not dirpt) (progn (princ "\nCanceled.") (exit))) (setq secLet (getstring T "\nEnter section letter (e.g., A, B): ")) (if (= secLet "") (setq secLet "A")) (setq baseAngle (angle pt1 pt2)) (setq dx (- (car pt2) (car pt1))) (setq dy (- (cadr pt2) (cadr pt1))) (setq cross (- (* dx (- (cadr dirpt) (cadr pt1))) (* dy (- (car dirpt) (car pt1))))) (setq normalAngle (if (> cross 0) (+ baseAngle (/ pi 2)) (- baseAngle (/ pi 2)) )) (command "._LINE" "_non" pt1 "_non" pt2 "") (defun drawArrow (basePoint / center p1 p2 tip) (setq center (polar basePoint normalAngle offset)) (setq p1 (polar center (+ baseAngle pi) (/ arrowBase 2.0))) (setq p2 (polar center baseAngle (/ arrowBase 2.0))) (setq tip (polar center normalAngle arrowHeight)) (command "._PLINE" "_non" p1 "_non" tip "_non" p2 "_non" p1 "") (command "._HATCH" "SOLID" "_L" "" "") center ) (setq arrow1Base (polar pt1 baseAngle arrowOffset)) (setq center1 (drawArrow arrow1Base)) (setq arrow2Base (polar pt2 (+ baseAngle pi) arrowOffset)) (setq center2 (drawArrow arrow2Base)) (defun fix-angle (a) (setq grad (* 200.0 (/ a pi))) (if (or (> grad 100) (< grad -100)) (+ a pi) a ) ) (setq txtAngle1 (fix-angle (+ normalAngle pi))) (setq angleGrad1 (* 200.0 (/ txtAngle1 pi))) (setq txtpt1 (polar center1 (+ normalAngle pi) letterOffset)) (setq txtpt2 (polar center2 (+ normalAngle pi) letterOffset)) (command "._TEXT" "J" "MC" "_non" txtpt1 0.27 angleGrad1 secLet) (command "._TEXT" "J" "MC" "_non" txtpt2 0.27 angleGrad1 secLet) (princ "\nSection line created successfully.") (princ) ) Thanks -
Help: Section Line for Architecture Drawings
mhy3sx replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
Hi BIGAL , PARAMETRICSTRETCH not exist in ZWCAD Thanks -
Exit the command with the right mouse button in one click
Nikon replied to Nikon's topic in AutoLISP, Visual LISP & DCL
I need to edit the text and change the color. -
Hello, With the help of AI I am trying to make a .lsp script that insert specific block on every vertex of a polyline and orient two "arrows" to the previous and next vertex. I try with different AI models and always I end up with error in Autocad (I use Autocad 2022) Error: "ActiveX Server returned the error: unknown name: "DYNAMICBLOCKPROPERTIES". AI say that the block is not really a dynamic block, which I dont get, how block can be not really dynamic. I am attaching both block and .lsp script. I hope someone will give me some advice what is wrong with the block or with .lsp script. BlockInsert.lsp block.dwg
-
Exit the command with the right mouse button in one click
GLAVCVS replied to Nikon's topic in AutoLISP, Visual LISP & DCL
Do you only need to change the color or also edit the text? -
Exit the command with the right mouse button in one click
Nikon posted a topic in AutoLISP, Visual LISP & DCL
Good day everyone! After editing the text, its color changes, but to exit the command, you need to press RMB or enter or Esc twice. Is it possible to complete the execution of the command with the right mouse button in one click? ;; If the current color is not equal to 136, then change it to 136. ;; If the current color is 136, then change it to 230. (defun c:TEcolor136_230 (/ error oldcmdecho sel e type obj res currentColor) (vl-load-com) (defun error (msg) (if oldcmdecho (setvar "CMDECHO" oldcmdecho)) (if (and msg (not (wcmatch (strcase msg) "BREAK,CANCEL,EXIT"))) (princ (strcat " Error: " msg)) ) (princ) ) (setq oldcmdecho (getvar "CMDECHO")) (setvar "CMDECHO" 0) (while (setq sel (entsel " Select TEXT/MTEXT to edit (Enter — exit): ")) (setq e (car sel) type (strcase (cdr (assoc 0 (entget e)))) ) (if (wcmatch type "TEXT,MTEXT") (progn (setq obj (vlax-ename->vla-object e)) ;; get the current color (setq currentColor (vl-catch-all-apply 'vlax-get-property (list obj 'Color)) ) ;; Error handling on receipt (if (vl-catch-all-error-p currentColor) (setq currentColor 0) ) ;; Opening the text editor (setq res (vl-catch-all-apply 'vl-cmdf (list "_.textedit" e)) ) (if (vl-catch-all-error-p res) (princ " Editing canceled.") ;; After editing, we change the color (progn (if (= currentColor 136) ;; If it's 136, change it to 230. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 230)) ) (princ " Couldn't change color to 230.") (princ " The color has been changed to 230.") ) ) (if (/= currentColor 136) ;; If it's not 136, change it to 136. (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-put-property (list obj 'Color 136)) ) (princ " Couldn't change the color to 136.") (princ " The color has been changed to 136.") ) ) (princ " Editing completed.") ) ) ) (princ " It's not an object TEXT/MTEXT.") ) ) (setvar "CMDECHO" oldcmdecho) (princ) ) -
Help: Section Line for Architecture Drawings
BIGAL replied to mhy3sx's topic in AutoLISP, Visual LISP & DCL
There is parametrics in Bricscad, similar to dynamic block in Acad. Here is a sample think of the two circles as the section arrow details. Can add attributes etc. I just made a block with gap set to 100, then did Bedit and typed PARAMETRICSTRETCH, follow prompts just select one side. Can add a lisp pick 2 points for alignment and reset length. section.dwg - Last week
-
Another ; make table example ; By Alan H 2018 ; updated for post https://www.cadtutor.net/forum/topic/98664-tables/ Aug 2025 (defun c:maketableXY (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao vgms) (vl-load-com) (setvar "osmode" 0) (setq bm (ssget '((0 . "LINE")))) (if bm (progn (setq num (sslength bm)) (setq i 0) (setq point_list '()) (repeat num (setq obj (ssname bm i)) ; Get entity name (setq db (entget obj)) ; Get entity data (setq p1 (cdr (assoc 10 db))) ; Start point (setq p2 (cdr (assoc 11 db))) ; End point (setq midpt (mapcar '/ (mapcar '+ p1 p2) '(2 2 2))) (setq point_list (cons (list p1 p2 midpt) point_list)) (setq i (1+ i)) ) ) ) (setq sp (vlax-3d-point (getpoint "pick a point for table"))) (Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq numrows (+ (length point_list))) (setq numcolumns 4) (setq rowheight 9) (setq colwidth 70) (setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Line details") (vla-settext objtable 1 0 "Sr No.") (vla-settext objtable 1 1 "Start point") (vla-settext objtable 1 2 "End point") (vla-settext objtable 1 3 "Mid point") (vla-setcolumnwidth objtable 0 21) (vla-setalignment objTable acTitleRow acMiddleCenter) (vla-setalignment objTable acHeaderRow acMiddleCenter) (vla-setalignment objTable acDataRow acMiddleCenter) (vla-setrowheight objTable acDataRow 9.0) (setq row 2 x 1) (foreach val point_list (vla-settext objtable row 0 (rtos x 2 0)) (setq val1 (strcat (rtos (car (nth 0 val)) 2 3) "," (rtos (cadr (nth 0 val)) 2 3))) (vla-settext objtable row 1 val1) (setq val2 (strcat (rtos (car (nth 1 val)) 2 3) "," (rtos (cadr (nth 1 val)) 2 3))) (vla-settext objtable row 2 val2) (setq val3 (strcat (rtos (car (nth 2 val)) 2 3) "," (rtos (cadr (nth 2 val)) 2 3))) (vla-settext objtable row 3 val3) (setq row (1+ row) x (1+ x)) ) (princ) )
-
For designing waterfalls or streams, SketchUp is a very user-friendly option for 3D modeling and conceptual designs. Blender is free and allows realistic 3D water simulations, though it has a steeper learning curve. Realtime Landscaping Architect is also beginner-friendly and specifically tailored for landscaping with waterfalls and streams. For precise 2D layouts, AutoCAD or AutoCAD Civil 3D is a good choice.
-
Danielm103 started following Performance helps for Large-Scale Z-Flattening (Z0) AutoLISP Routine?
-
Performance helps for Large-Scale Z-Flattening (Z0) AutoLISP Routine?
Danielm103 replied to p7q's topic in AutoLISP, Visual LISP & DCL
see if this drawing is correct. I used project from pyrx import Ap, Ax, Db, Ge # register command @Ap.Command() def doit(): try: db = Db.curDb() ms = db.modelSpace(Db.OpenMode.kForWrite) plane = Ge.Plane(Ge.Point3d.kOrigin,Ge.Vector3d.kZAxis) for id in ms.objectIds(Db.Curve.desc()): dbc = Db.Curve(id) gec = dbc.getAcGeCurve() geproj = gec.project(plane,Ge.Vector3d.kZAxis) if not geproj.isKindOf(Ge.kCurve3d): continue geprojCurve = Ge.Curve3d.cast(geproj) dbproj = Db.Core.convertGelibCurveToAcDbCurve(geprojCurve) ms.appendAcDbEntity(dbproj) dbproj.setColorIndex(1) except Exception as err: print(err) arc2.dwg