Leaderboard

So Entmake is an alternative method for creating entities. If you type: (entget (car (entsel "Select an entity"))) into the command line and select something you'll get something like this: ((-1 . <Entity name: 26308e8d720>) (0 . "LINE") (330 . <Entity name: 2635ff791f0>) (5 . "43F2") (100 . "AcDbE.... You probably know this. The list items in brackets for example (0 . "LINE") are dotted pairs, the first number is the reference the second is the value it refers to. Here, 0 and "LINE" With entmake you are creating an entity directly with these codes and bypassing the CAD user interface commands.. so it can be a little quicker (like a second every 100 entities created, not enough to get a drink), but you also get a little more control perhaps. There are lists out there with the bare minimum dotted pairs to create an entity, some are optional and revert to default. For example the code 62 generally refers to colour, if you don't use it, you get whatever it is set at in your system. A basic overview. So jumping back to my first line here, you can interrogate any entity to see what is required in its creation. Some like points are very simple, some like polylines are more complex. A handy thing to refer to when entmake -ing entities. .... you did say ready for more?..... I have a library of entmake LISPs and just call them as I want. So in the LISP above you might create this somewhere to create a LWPolyline: (defun MakeLWPoly ( lst cls lay / MyLWPoly ) (setq LWPoly (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 lay) ;; Not necessary, can be commented out, it is useful (cons 90 (length lst)) (cons 70 cls) ) ; end list (mapcar (function (lambda (p) (cons 10 p))) lst) ) ; end append ) ; end entmakex ) ; end setq ); end defun and in your LISP call it with (setq NewLWPolyLine (MakeLWPoly lst cls lay) ) Where lst is a list of points for the polyline, cls is whether it is closed (1 for closed, 0 for open, as numbers not a string) and lay here is the layer for the polyline. lay isn't necessary, see the note in the code too. So try it and see how it works, maybe see if you can add in a colour which will require a colour index colour (number 0 to 255). Sometimes the order of the list is important so use the first line (entget...) to work out where it insert dotted pairs in the same order Last couple of notes, in the list above I use cons to create the dotted pairs and allows the routine to use variables, you can also use '(0 . "LINE") for example if that never changes. You don't need to specify entiy name - CAD will do that on creation And Entmake or Entmakex, entmakex returns the entity name, entmake doesn't so in my calling line I can use setq and have a reference for the new entity created - with entmake you might need to use (entlast) to get that reference. Final final note, from this you can go on to entmod and modifying existing entities through the entity definition directly.

@Steven P well, using "_non" before the point seems to work, even with o-snaps on. so good tip. that was baffling me. Ok, ready for more. I'll lookup entmake see what I can figure out. Thanks again!

You're in double luck.... I created a a similar routine in the same thread as pkenewell, an alternative method. Likewise, the same text length limit applies - can adjust these if that becomes an issue (for most things, 256 characters is usually enough except a notes block of text) (defun c:TxtRemCR ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ; txt remove carriage returns ;;Sub Functions: ;;Starting with LM: Refer to Lee Macs website (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (princ "\nSelect MText") ;; Note in command line "Select text" (setq MySS (ssget '((0 . "MTEXT")))) ;; Select objects with a selection set, filtered to 'MTEXT' entity type (setq SSCount 0) ;; Just a counter set to 0 (while (< SSCount (sslength MySS)) ;; loop through length or selection set using SSCount (setq MyEnt (ssname MySS SSCount)) ;; get the nth item in the selection set entity name (setq MyEntGet (entget MyEnt)) ;; get the entity definition from the above (setq MyText (cdr (assoc 1 MyEntGet))) ;; get the text from the entity (first 256 characters) (setq TextList (LM:str->lst MyText "\n")) ;; Convert the text string to a list, deliminator \n (new line) (setq MyEntGet (subst (cons 1 (LM:lst->str TextList " ")) (assoc 1 MyEntGet) MyEntGet)) (entmod MyEntGet) ;; Modify the text (setq SSCount (+ SSCount 1)) ) ; end while ); end function

whoops - yes, before sorry! There is a reason I usually go with entmake, don't need to worry about that ( I did a check 450+ LISPs in my main library and I have used "_non" in 8! Not something I use every day)

OK - found something. I did some searching on earlier solutions to the problem. Try this code - it's working for me. It could be made shorter I think, but it works (use the code below, not the link). Credit to Roy_043 from this post: (defun c:AB (/ blk doc i obj SS) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for blk (vla-get-Blocks doc) (if (and (= (vla-get-isxref blk) :VLAX-FALSE) ;ignores xrefs (not (wcmatch (vla-get-name blk) "*`**,*|*")) ;ignores anonymous and xref blocks ) (vlax-for obj blk (vla-put-Color obj 0) ;change all elements inside block to byblock ) ) ) (if (setq SS (ssget "_X" '((0 . "INSERT")))) (repeat (setq i (sslength ss)) (ChangeDynBlockColor (vla-get-name (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))) 0) (vla-put-color obj 200) ) ) (vla-regen doc acAllViewports) (vla-EndUndoMark doc) (princ) ) ; Blk can be a block name or the ename of a "BLOCK" entity. (defun KGA_BlockClassic_EffectiveName (blk / elst blkRecHnd) (setq elst (entget (if (= 'ename (type blk)) blk (tblobjname "block" blk)))) (if (and (= "*" (substr (cdr (assoc 2 elst)) 1 1)) (setq blkRecHnd (cdr (assoc 1005 (cdadr (assoc -3 (entget (cdr (assoc 330 elst)) '("AcDbBlockRepBTag"))))))) ) (cdr (assoc 2 (entget (handent blkRecHnd)))) (cdr (assoc 2 elst)) ) ) ; (ChangeDynBlockColor (vla-get-name (vlax-ename->vla-object (car (entsel)))) (acad_colordlg 2)) (defun ChangeDynBlockColor (nme col / N_Mod blks i nmeLst) (defun N_Mod (blk) (vlax-for obj blk (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (not (vl-position (strcase (vla-get-effectivename obj)) nmeLst)) ) (setq nmeLst (append nmeLst (list (strcase (vla-get-effectivename obj))))) ; Append required. (vla-put-color obj col) ) ) ) (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq nmeLst (list (strcase (KGA_BlockClassic_EffectiveName nme)))) (setq i 0) (while (< i (length nmeLst)) (setq nme (nth i nmeLst)) (vlax-for blk blks (if (= nme (strcase (KGA_BlockClassic_EffectiveName (vla-get-name blk)))) (N_Mod blk) ) ) (setq i (1+ i)) ) )

@jim78b I don't know. I just don't deal with dynamic blocks so I am not sure why its not already working. I'm just missing something that maybe someone else here knows better?

I guess what you are trying to do is this: (if (setq p (getpoint "\nSpecify a point to insert the text: ")) (entmake (list '(0 . "TEXT") '(100 . "AcDbText") (cons 10 (trans p 1 0)) (cons 40 250) (cons 1 (rtos v 2 3)) (cons 50 (angle '(0 0) (getvar 'ucsxdir))) ) ) (princ (strcat "\nThe result is: " (rtos V 2 3) " m3")) ) Which makes either put a text with the result (just the number of the volume) or put it on the command line, or if you want to put it clear: (cons 1 (strcat "Volume = " (rtos v 2 3) " m3")) To be clear, this should be: (princ (strcat "\nresult" (rtos V 2 3))) Close the quotes " " and convert the real to string

@jim78b OK - I see. you have nested blocks within nested dynamic blocks. You need some kind of recursive function to drill all the way down. Not sure if I can help, but I'll give it a try as soon as I have some time. For now, you can open up one of each of the dynamic clocks in refedit and run your command again and they will be done. Open the main block first with double click, then open the dynamic blocks with double-click and run AB on each of them.

Sure - try this (untested): (defun c:listdupepoints ( / d e i l p s ) (if (setq s (ssget '((0 . "POINT")))) (progn (setq d (ssadd)) (repeat (setq i (sslength s)) (setq i (1- i) e (ssname s i) p (cdr (assoc 10 (entget e))) ) (if (vl-some (function (lambda ( x ) (equal p x 1e-3))) l) (ssadd e d) (setq l (cons p l)) ) ) (if (zerop (sslength d)) (princ "\nNo duplicate points found.") (sssetfirst nil d) ) ) ) (princ) )

@Tharwat Oops - your right. I just altered the original routine and didn't check. I updated my post. @jim78b Be more specific on your post. My alteration to your routine just excludes dimensions from the changing of the color that you had in your original. Now I don't really understand exactly what you want. Post a sample drawing with the before and after.

Going to add a slight different one here, it asks the user for input to select the text and the new order. If you don't enter a line number that line is deleted. Works with up to 256 characters in the text (including the new line reference and any other formatting)/ 256 Characters -should- be plenty for the OPs example I think. EDIT Edited the code to select many mtext strings and do the same change to them all, and some annotations in the code. (defun c:swapmt ( / MySS SSCountMyEnt MyEntGet Mytext TextList OrderList NewText n acount) ;;Sub Functions: ;;Starting with LM: Refer to Lee Macs website (defun LM:str->lst ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) (defun LM:lst->str ( lst del ) (if (cdr lst) (strcat (car lst) del (LM:lst->str (cdr lst) del)) (car lst) ) ) (princ "\nSelect MText") ;; Note in command line "Select text" (setq MySS (ssget '((0 . "MTEXT")))) ;; Select objects with a selection set, filtered to 'MTEXT' entity type (setq OrderList (LM:str->lst (getstring "Enter Order with spaces (x y z)" t) " ")) ;; Create a list from a user inputted string ;;There is a better way to do the above linie I think, loop with get int till user presses enter (setq SSCount 0) ;; Just a counter set to 0 (while (< SSCount (sslength MySS)) ;; loop through length or selection set using SSCount (setq MyEnt (ssname MySS SSCount)) ;; get the nth item in the selection set entity name (setq MyEntGet (entget MyEnt)) ;; get the entity definition from the above (setq MyText (cdr (assoc 1 MyEntGet))) ;; get the text from the entity (first 256 characters) (setq TextList (LM:str->lst MyText "\n")) ;; Convert the text string to a list, deliminator \n (new line) (setq NewText (list)) ;; Create a blank list to append to later (if (or (< (length OrderList) (length TextList)) ;; If the order list from above is longer (= (length OrderList) (length TextList)) ;; or equal to the number of lines in the text string ) ; endor (foreach n OrderList (setq NewText (append NewText (list (nth (- (atoi n) 1) TextList))) ) ;; Create a new list according to the order list order ) ; end foreach (progn ;; Text list is longer than the order list (setq acount 0) ;; A Counter (while (< acount (length TextList)) ;; Loop through for the length of the text list (done this way so always smething to look at) (setq NewText (append NewText (list (nth (- (atoi (nth acount OrderList)) 1 ) TextList))) ) ;; create a new list as above (setq acount (+ acount 1)) ) ; end while ) ; end progn ) ; end if (setq MyEntGet (subst (cons 1 (LM:lst->str NewText "\n")) (assoc 1 MyEntGet) MyEntGet)) ;; Create a new entity definiton replacing text (entmod MyEntGet) ;; Modify the text (setq SSCount (+ SSCount 1)) ) ; end while ); end function

Look into SOLVIEW/SOLDRAW and SOLPROF if I understand what you are wanting. Post a .dwg and/or an image of before and after would help.

My mistake, should have seen the right formula first, now is fixed, you were right the first time, just multiply for 0.000001 or divide by 1000000

Hope this solves your problem, just the linear scale is missing, but I guess you can handle it from here. ;;; Volume of a truncated piramid square based ;;; https://www.cadtutor.net/forum/topic/79210-the-volume-of-the-foundation-ditch-through-lisp/ (defun C:W2d( / h oe pl1 pl2 s1 s2 v) (vl-load-com) (setq oe (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq pl1 (car (entsel "\nSpecify the polyline PL1:"))) (setq s1 (vla-get-area (vlax-ename->vla-object pl1))) (setq pl2 (car (entsel "\nSpecify the polyline PL2:"))) (setq s2 (vla-get-area (vlax-ename->vla-object pl2))) (setq h (getreal "\nEnter the height (h) of the excavation: ")) (setq v (* (/ (+ s1 s2 (sqrt (* s1 s2))) (* 3 1000000)) h)) (princ (strcat "\nThe Volume of the excavation is: " (rtos v 2 3) " m3")) (setvar 'cmdecho oe) (princ) )

So ; ?receive the area S1? (setq s1 (vlax-get (vlax-ename->vla-object pl1) 'area)) (setq h (getreal "\nEnter height ")) Not tested formula V=1/3h(S1+S2+sqrt(S1*S2)) (setq s1s2 (* s1 s2)) (setq s1s2 (sqrt s1s2)) (setq s1s2 (+ s1 s2 s1s2)) (setq vol (/ s1s2 (* 3.0 h)))

Not really sure about break but if using multiple layouts can you not have multiple views of a large object at a scale ? Just set up 1st layout, scale etc,, then copy layout and pan the mview then lock viewport.

@Highvoltage You're in luck. I just created a very similar routine for another poster. In addition to the problem with (vl-string-subst), one of other the problems with using DXF is sometimes the mtext string is separated into multiple DXF codes if the text is more than 250 chars. The additional codes use DXF code 3 instead of 1. It's better to get the full text string using ActiveX and parsing it. Try the following instead: (defun c:mbch (/ _StrParse d obj ss tls txt) (vl-load-com) (vla-StartUndoMark (setq d (vla-get-activedocument (vlax-get-acad-object)))) (defun _StrParse (str del / pos) (if (and str del) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (_StrParse (substr str (+ pos 1 (strlen del))) del)) (list str) ) ) ) (princ "\nSelect MTEXT Objects: ") (if (setq ss (ssget '((0 . "MTEXT")))) (repeat (setq n (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) txt (vla-get-textstring obj) tls (_strparse txt "\\P") ) (if (> (length tls) 1) (setq txt (apply 'strcat (cons (car tls)(mapcar '(lambda (x)(strcat " " x)) (cdr tls)))) obj (vla-put-textstring obj txt) ) ) ) ) (redraw) (vla-endundomark d) (princ) )