All Activity

Coming back to this one, I was thinking first off a simple task to write something faster - things like the arcs to ellipses slowing things down a bit. Maybe a different approach, are you able to share the LISP you have now, the one that works, and we can look to see if we can make it work faster?

Hi everyone, Firstly I would like to thank all the help I have received the past few months in my journey in learning Lisps and Macros. So, I am creating a CUI that has buttons each button represent a block (e.g. Manhole, Street Lighting Column, Tactile Paving). All these blocks are saved individually in a folder (e.g. Manhole.dwg, Street Lighting.dwg etc). The CUI has a Macro *^C^C-insert;"LE-D-RWP";\;;;explode;last;-purge;Blocks;"LE-D-RWP";N; The above above macro uses combination of insert command and purge to keep the drawing clean from the dwg block that it will bring in. Now while this method is good to bring the block in the drawing it is not very optimal when the block already exists in the drawing. Also, this can be a maintenance nightmare if you have 20+ Blocks (that means 20 dwgs that you will have to access and update something e.g. Layer color, name etc). Last week I found out that you can Setq within a CUI, so I had a lightbulb moment! The idea is this: I have one master dwg that will have all my blocks (easier to maintain and update) and will update the CUI to set the insertion block name global variable and then call a lisp that will import the block from the master dwg (Maybe something similar to Lee Mac Steal?). So my question is the following, is there a simpler version of Lee Mac's Steal command that can access the blocks from the dwg? Lee Mac's steal lisp is over 1400 lines of code which will take a while to review and update. ;;CUI Macro (setq Global_InsBlockName "Block1");(LOAD "STEALUPDATE");STEALUPDATE; ;;Modified Lee Mac Steal Lisp ;;From Drawing X ;;Import Global_InsBlockName I believe this way I can have as many buttons for inserting blocks as I need by having only 1 dwg to insert from. Also it will make maintaining the CUI and Lisp code more manageable. What are your thoughts?

Try this: No error checking, or checking you have selected the correct polyline. Works only of LWPolylines - comment again if you want this to do 3d polylines as well. I haven't put many notes in this as to how it works, but look through and see if it makes sense. One thing I noticed is your sample block - to me - was an anonymous block name - which might have been the error you noticed (some technical stuff made it so) - as a fix I copied the block entities and created a new block, calling it "Arrow". You'll need to set your block name in the LISP below to the block you want to use (see (Setq MyBlockName "Arrow") line for what to change). (defun c:blockinsert ( / ent MyEnt acount EntCoords MyBlock MyBlockName Ang1 Ang2) ;; Initial Values (setq MyBlockName "Arrow") ;; Change this to your block name ;;Sub functions (defun mAssoc ( key lst / result ) ;; Lee Mac: CadTutor forum (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) (defun LM:getvisibilitystate ( blk / vis ) ;; Lee Mac (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) (defun LM:setdynprops ( blk lst / itm ) ;; Lee Mac (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) (defun SetAng ( Ang1 Ang2 MyEnt / ) ;; From Lee Macs LISPs. Change 'cons' "Angle", "Angle1" to suit dynamic block (lm:setdynprops (vlax-ename->vla-object MyEnt) (list (cons "Angle" Ang1) (cons "Angle1" Ang2))) ; Ang in radians ) (defun AddBlock ( BName Pt XScale YScale ZScale / ) ;; Adds block to the drawing (setq NewBlock (entmakex (list '(0 . "INSERT") (cons 2 BName) (cons 10 Pt) (cons 41 XScale) (cons 42 YScale) (cons 43 ZScale) (cons 50 0); ))) ; end setq entmakex, list NewBlock ) ;; End sub functions (setq Ent (car(entsel "Select LW Polyline"))) (setq MyEnt (entget Ent)) (if (or (equal (cdr (assoc 0 MyEnt)) "LWPOLYLINE") ) ; end or (progn (setq EntCoords (massoc 10 MyEnt)) (setq acount 0) (while (< acount (length EntCoords)) ;;Insert (setq MyBlock (AddBlock MyBlockName (nth acount EntCoords) 1 1 1) ) ;;Ang1 (if (= acount 0) ; First point (progn (setq ang1 (angle (nth acount EntCoords) (nth (+ acount 1) EntCoords) )) ; = ang2 ) ; end progn (progn (setq ang1 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ) ; end progn ) ; end if ;;Ang2 (if (= acount (- (length EntCoords) 1)) ; last point (progn (setq ang2 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ; = ang1 (setq ang2 (angle (nth (- acount 1) EntCoords) (nth acount EntCoords) )) ) (progn (setq ang2 (angle (nth (+ acount 1) EntCoords) (nth acount EntCoords) )) ) ) ; end if (SetAng Ang1 Ang2 (entlast)) ;; Sets dynamic block angle (setq acount (+ acount 1)) ) ; end while ) (progn (princ "Polyline not selected") ) ; end progn ) ; end if polyline (princ) ; exit quietly )

This is the first possibilitie. The second possibilitie that i only want to select multiple texts (not edited) and if: -the current color is not equal to 136, then change it to 136. -the current color is 136, then change it to 230. thanks for your help!

Do you want to edit the content of a text and apply the same modification to the rest of the selected texts?

Thanks to all

I'd be forgetting AI for now, handy for snippets but still not quiet there. Lee Mac has some great resources: https://lee-mac.com/dynamicblockfunctions.html might be what you are looking for. Also search this forum for Massoc Implementations which can be used to return a list of vertices. (defun mAssoc ( key lst / result ) (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) Will give a list of points along a polyline where key in this case is 10, and list is the polyline entity description from maybe (entget (car (entsel))) Dynamic blocks: (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) (lm:getdynprops (vlax-ename->vla-object (car(entsel))) ) returns the format and names of dynamic block variables and setting them with: (defun LM:setdynprops ( blk lst / itm ) (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) (lm:setdynprops (vlax-ename->vla-object (car(entsel))) (list (cons "Angle" 0) (cons "Angle2" pi))) Inserting the blocks can be as simple as (command "insert" "Stylb_NN_nov" -Point- "" "" "") where point is the points along the massoc returned list (ignore the 1st and last point) and then use (entlast) in the setdynprops line instead of (car(entsel)) Might be a pointer to get you making something up.

Hi Bigal, With the GLAVCVS's lisp (TEcolor136_230), i can only select text one by one. I would like to select several text at the same time in the selection. Thanks for your help.

@thekiki what did you have in mind to do with the selected text ?

Ok thats is very similar to what I was talking about, its easy to draw an arrow at a point along a pline, you can do this in a number of ways one of the easiest is to just use "V" rotated + - to to the angle between the points. Which of these is correct ? You should post a dwg not an image, can then see sizes and offsets from vertices.

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

@GLAVCVS thank you very much for the 2 options, I like both options, but the first option suits me better.

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) )

I hope the 'textedit' options in your version of AutoCAD aren't a problem.

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) )

That's fine with me...

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.

Thanks Saxlle. Works fine

@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.

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.

@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.

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/