Leaderboard

If Plot Transparency is ticked, try increasing the transparency value, 29 isn't very much for a solid hatch.

My pleasure. I think I know what you are after and why. Could you upload a small sample drawing of before and after. I did notice that some of the blocks were mirrored so accounting for this may make it slightly more difficult

You'll need to escape the double-quotes, i.e. (setq loc_sys " ;Start of value for variable 15000.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.0 unknow0=)94uv}@<>2&92<k4$-.\"l,Z?eIAVy4$-.\"l)[AUIAV4$-.\"l)[/UIA4$-.\"l*J/UIzey\" W000022402200.00.02.40855436775217460.0-5862800.0500000.00.00.00.00.00.00.00.00.00.00.00.00.01.00.0.000.0 false0truetrue0.00.00.00.00.00.00.00.00.00.0.00.00.01.01.722-98.0596.2831752114194910.99998390891079565.598554528. 340.00.00.01.00.00.00.00.00.00.00.00.00.00.0-12.256-19.618-107.1391097836.266554755.6920.00.00.00.00.0003end " ;End of value for variable ); end of setq But it's a really odd value.

OK. Try this. (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vla-get-layers c_doc) clyr (getvar 'clayer) );end_setq (prompt "\nSelect Polylines : ") (setq ss (ssget '((0 . "*POLYLINE")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines (t (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3) elev (caddr (car p_lst)) );end_setq ) );end_cond (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt)) (vlax-put-property pl_obj 'layer lyr_txt) );end_repeat ) );end_cond (setvar 'clayer clyr) (princ) );end_defun This has been minimally test, and utilises some visual lisp hence the inclusion of (vl-load-com). It works in my small scale test. There is no local error sub.

Ok - so trying to understand your original post: "how i can edit the qleader command, when i press :le i draw a quick leader on a layer but I can't bring it back to layer 0," The best tool for this is the previously mentioned Layer Manager tool by Lee Mac, "...but if i write LE i draw a quick leader!" LE is a command Alias controlled by the acad.pgp file. You can edit the command Aliases quickly using the Express Tools "Aliasedit" command. Otherwise you have to find the acad.pgp file in the support folders and edit the file in notepad. NOTE: You cannot put macro strings in this file - only straight commands. "i create a new command qleader and write this code: ^C^C-layer;set;AM_5; _QLEADER;\\\ ^C^C_CLAYER 0; 1. don't back to layer 0 2. if i write LE command not recall my command!" 1) Step through the QLEADER command - you only have 3 pauses and you probably need more. It is not an easy macro to do because there is a variable amount of inputs. You would be better to go to an AutoLISP macro for this, something like: (defun C:QLL () (setvar "CLAYER" "AM_5") (command "._QLEADER") (while (= (logand (getvar "cmdactive") 1) 1) (command pause) ) (setvar "CLAYER" "0") (princ) ) 2) Your Macro in a Toolbar button is not recalled with a command Alias, only from the toolbar button; it does not redefine either the "QLEADER" command or the "LE" Alias. However - if you load the simple LISP I wrote above into your drawing - you can use the command "QLL" from the command line or a toolbar.

I have this alternative that avoids copying the original, but assumes that the mid point of the block is the mid point of the line. I have changed the the routine name to BPER2 so you will need to type this instead of TEST on the command line. It is tested and seems to do exactly the same as the previous one, and should be faster. (defun rh:gbbc (obj / ll ur lst c_pt) (if (and obj (= (type obj) 'ENAME)) (setq obj (vlax-ename->vla-object obj))) (cond (obj (vlax-invoke-method obj 'getboundingbox 'll 'ur) (setq lst (mapcar 'vlax-safearray->list (list ll ur)) c_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst)) );end_setq ) );end_cond c_pt );end_defun (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:bper2 ( / *error* c_doc c_spc l_obj ent e_lst ss cnt obj s_pt m_pt e_pt x_obj x_pts s_d d_lst x_pt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg))) (princ) );end_defun *error* (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (while (not l_obj) (setq ent (car (entsel "\nSelect Line : ")) e_lst (entget ent) );end_setq (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent))) );end_while (if (and (princ "\nSelect Bars : ")(setq ss (ssget ":L" '((0 . "INSERT")(2 . "`*U*"))))) (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) s_pt (vlax-get obj 'insertionpoint) m_pt (rh:gbbc obj) e_pt (polar s_pt (angle s_pt m_pt) (* (distance s_pt m_pt) 2.0)) x_obj (vlax-invoke c_spc 'addxline s_pt e_pt) x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3) s_d 1.0e200 d_lst nil );end_setq (vla-delete x_obj) (foreach x_pt x_pts (if (< (setq d (distance x_pt s_pt)) s_d) (setq s_d d d_lst (list s_pt x_pt))) (if (< (setq d (distance x_pt e_pt)) s_d) (setq s_d d d_lst (list e_pt x_pt))) );end_foreach (vlax-invoke obj 'move (car d_lst) (cadr d_lst)) );end_repeat );end_if (princ) );end_defun

If the blocks you sent me are the ones you are using then the routine works. The copy and explode does not affect the original block, it will always remain, the exploding is carried out on the copy. The copied block and the exploded entities are all deleted. I think you are trying to move these to the nearest polyline is that correct. If so try this amended routine. (defun rh:oppend ( obj / n_obj b_objs l_obj s_pt e_pt rtn) (if (= (type obj) 'ENAME) (setq obj (vlax-ename->vla-object obj))) (cond ( (= "AcDbBlockReference" (vlax-get obj 'objectname)) (setq n_obj (vla-copy obj) b_objs (vlax-invoke n_obj 'explode) l_obj (car (vl-remove-if-not '(lambda (x) (= (vlax-get x 'objectname) "AcDbLine")) b_objs)) s_pt (vlax-get l_obj 'startpoint) e_pt (vlax-get l_obj 'endpoint) ) (vla-delete n_obj) (mapcar '(lambda (x) (vla-delete x)) b_objs) (if (equal (vlax-get obj 'insertionpoint) s_pt 0.001) (setq rtn e_pt) (setq rtn s_pt)) ) );end_cond rtn );end_defun (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:test ( / *error* c_doc c_spc l_obj ent e_lst ss cnt obj s_pt e_pt x_obj x_pts s_d d_lst x_pt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg))) (princ) );end_defun *error* (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (while (not l_obj) (setq ent (car (entsel "\nSelect Line : ")) e_lst (entget ent) );end_setq (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent))) );end_while (if (and (princ "\nSelect Bars : ")(setq ss (ssget ":L" '((0 . "INSERT")(2 . "`*U*"))))) (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) s_pt (vlax-get obj 'insertionpoint) e_pt (rh:oppend obj) x_obj (vlax-invoke c_spc 'addxline s_pt e_pt) x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3) s_d 1.0e200 d_lst nil );end_setq (vla-delete x_obj) (foreach x_pt x_pts (if (< (setq d (distance x_pt s_pt)) s_d) (setq s_d d d_lst (list s_pt x_pt))) (if (< (setq d (distance x_pt e_pt)) s_d) (setq s_d d d_lst (list e_pt x_pt))) );end_foreach (vlax-invoke obj 'move (car d_lst) (cadr d_lst)) );end_repeat );end_if (princ) );end_defun This is tested on your drawing, works, but may not be exactly what you want. Once loaded type TEST to run it

It's different time zone, i think @dlanorh will soon reply if he wakes up, so please be patient. His rh:oppend sub function requires single ENAME or VLA-OBJECT type as argument, not a PICKSET (selectionset) (rh:oppend (car(entsel)) ) ; ENAME (rh:oppend (ssname (ssget) 0)) ; first item in selection set you can use repeat, while, foreach loop to iterate in selection set.

(setq n_obj (vla-copy ent) (vla-copy obj)

If the error persists, or try this shorter routine as an alternative without using COM API. Its just a simpler algorithm merely sorting each row of TEXT from top to bottom. since it does not collect line coordinates and the output just a normal 'csv' file, so don't expect auto cell formatting, column size, alignment etc.. however you still can format cell easily in EXCEL sheet & rename as .xls. (defun c:tt (/ *error* foo ss fn f a b l ls l1 lst) ;hanhphuc 28.10.2019 (defun *error* (msg) (if (and f (= (type f) 'FILE)) (close f) (setq f nil) ) ) (and (setq foo '((a b) (cdr (assoc a (entget b)))) ss (ssget '((0 . "TEXT") (8 . "Text"))) ) (setq l (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) ; (acet-ss-to-list ss) (setq fuzz (* 0.25 (foo 40 (car l))) ls (mapcar ''((x) (cons (foo 1 x) (foo 10 x))) l) ) (setq fn (vl-filename-mktemp "table.csv") ) (setq f (open fn "w")) (setq l nil sl (vl-sort ls ''((a b) (if (equal (caddr a) (caddr b) fuzz) (< (cadr a) (cadr b)) (< (caddr a) (caddr b)) ) ) ) a (caddar sl) ) (foreach x sl (if (equal a (setq b (caddr x)) fuzz) (setq l1 (cons x l1) a b ) (setq l1 (vl-list* x nil l1)) ) (setq a b) ) ;_ end of foreach (foreach x (progn (foreach x l1 (if x (setq l (cons x l)) (setq lst (cons l lst) l nil ) ) ) (setq lst (cons l lst)) (reverse (vl-remove nil lst)) ) ; progn (write-line (apply 'strcat (mapcar ''((x) (strcat x ",")) (mapcar 'car x))) f) ) (progn (if f (close f) ) (vl-cmdf "start" fn) ; or (vl-cmdf "shell" fn) doesn't work if same filename opened i.e:locked for editting ;(startapp "notepad" fn) ; recommand to use this for mutiple files ) ) ;and (princ) ) (or (wcmatch (strcase (getvar 'dwgname)) "*COORDINATE TABLE 1*") (alert "\nThis routine only tested in 'COORDINATE TABLE 1.dwg', \nPlease download at \nhttps://www.cadtutor.net/forum/topic/68979-export-cad-text-table-in-excel-get-error/" ) ) (princ) p/s: In case you have any blank cell in Table, just replace it with "-" or any TEXT! i.e. TEXT in each Cell in a Row must have content & aligned horizontally in WCS, otherwise texts merge from first column to next

Works 2020 very impressed !

I hope to help you but I don't have enough experience THANKS

the lisp COT_Convert_Old_TableV1.6a work Converts the table inside AutoCAD Then export it to Excel COORDINATE TABLE__convert (1).dwg

Works well for me at acad 2018 from tbltoex.xlsx

Works well on AutoCAD 2016 Sheet101.xlsx Sheet102.xlsx

AND THIS COT_Convert_Old_TableV1.6a.lsp

Try thiS LISP Export-Table-to-excel _ LispBox .LSP

Ok if its actually column of text then need something like pick column of text I have it somewhere trying to find. It sorts the selected text based on y value. Can have multiple columns. Needs a rewrite original 2004.

The main fact is that is not any ACADTABLE . it are lines and text arranged like a TABLE, but not an ACADTABLE

For what it's worth, it is not necessary to perform a nested copy of the polyline, nor explode the block reference in order to ascertain the polyline vertex coordinates with respect to the block reference - instead, you can transform the polyline vertices obtained from the block definition using the position, scale, rotation & orientation of the block reference. This is a very similar question to that posed in this thread. To offer an example, consider the following code: (defun c:test ( / ent enx lst ocs ) (while (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect block: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil ) ( (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) (princ "\nThe selected object is not a block.") ) ( (null (setq lst (blockreferencepolylinevertices ent))) (princ "\nThe selected block does not contain a 2D polyline on the Boundary layer.") ) ( (progn (setq ocs (cdr (assoc 210 enx))) (entmake (append (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 090 (length lst)) '(070 . 0) (cons 038 (cadddr (assoc 010 enx))) (cons 210 ocs) ) (mapcar '(lambda ( p ) (cons 10 (trans p 0 ocs))) lst) ) ) ) nil ) ( (princ "\nUnable to recreated nested polyline.")) ) ) ) (princ) ) (defun blockreferencepolylinevertices ( ref / elv ent enx lst ocs ) (setq ent (tblobjname "block" (cdr (assoc 2 (entget ref))))) (while (and (null lst) (setq ent (entnext ent)) (setq enx (entget ent)) ) (if (and (= "LWPOLYLINE" (cdr (assoc 0 enx))) (= "BOUNDARY" (strcase (cdr (assoc 8 enx)))) ) (setq elv (cdr (assoc 038 enx)) ocs (cdr (assoc 210 enx)) lst (mapcar '(lambda ( v ) (trans (list (cadr v) (caddr v) elv) ocs 0) ) (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) enx) ) ) ) ) (if lst (apply (function (lambda ( mat vec ) (mapcar (function (lambda ( vtx ) (mapcar '+ (mxv mat vtx) vec) ) ) lst ) ) ) (refgeom ref) ) ) ) ;; RefGeom (gile) ;; Returns a list whose first item is a 3x3 transformation matrix and ;; second item the object insertion point in its parent (xref, block or space) (defun refgeom ( ent / ang enx mat ocs ) (setq enx (entget ent) ang (cdr (assoc 050 enx)) ocs (cdr (assoc 210 enx)) ) (list (setq mat (mxm (mapcar '(lambda ( v ) (trans v 0 ocs t)) '( (1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0) ) ) (mxm (list (list (cos ang) (- (sin ang)) 0.0) (list (sin ang) (cos ang) 0.0) '(0.0 0.0 1.0) ) (list (list (cdr (assoc 41 enx)) 0.0 0.0) (list 0.0 (cdr (assoc 42 enx)) 0.0) (list 0.0 0.0 (cdr (assoc 43 enx))) ) ) ) ) (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0) (mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))) ) ) ) ;; Matrix Transpose - Doug Wilson ;; Args: m - nxn matrix (defun trp ( m ) (apply 'mapcar (cons 'list m)) ) ;; Matrix x Matrix - Vladimir Nesterovsky ;; Args: m,n - nxn matrices (defun mxm ( m n ) ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) (princ)

What happens when you drag and drop the shape file ?

Ah yes the answer is the $100 question, only joking, its not straight forward but it is achievable and again there are just so many answers to your question out there that do just that pick something in Autocad and put an answer in a Excel cell. This is why the csv is offered first as its simple. The excel answers always seem to come back with more requests for enhancements people like me offer solutions for free here, so Cadtutor should not be used as a I want for free. Start with getexcel.lsp. Again GOOGLE search here also, it may take say an hour but you will find what you want it is definitely out there.

Blocks don't have endpoints, only insertion points. So lets assume these are dimensions (they are saved as anonymous blocks), is that correct?

Not sure what happened but lost code from here. Will redo again. Please note the CMDactive crashes Briscad. Will look into it. ; reduce polygon facets by AlanH OCT 2019 (defun c:polred ( / x R lst co-ord plent) (setq plent (entsel "pick polygon")) (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))) (setq R (getint "Enter reduction factor 2 3 4 etc")) (setq x 0) (setq lst '()) (setq lst (cons (nth x co-ord) lst)) (repeat (- (/ (length co-ord) R) 1) (setq lst (cons (nth (setq x (+ x R)) co-ord) lst)) ) (setvar 'clayer "0") ; add your layer or else erase plent ;(command "erase" plent "") (command "_pline") (while (= (getvar "cmdactive") 1 ) (repeat (setq x (length lst)) (command (nth (setq x (- x 1)) lst)) ) (command "C") ) ) (c:polred)

If your file contains a geolocation marker it should allow you to see the geolocation tab in the Ribbon. Otherwise you can add a marker, using online maps and choose your coordinate system using 'setlocation' from the insert tab of the ribbon.

I keep having this same question. From what you're asking I don't know how far that point must be from the block. Look at this code, made for the dwg attachment. I have different blocks, with different rotations, and a rectangle. My code puts a point on the rectangle. It also puts a point along that same line at a distance 25 (Assuming your image has a text height of 2.5, those points you want are at that distance) Command BFP (defun drawPoint (pt) (entmakex (list (cons 0 "POINT") (cons 10 pt))) ) (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method ;; acextendnone Do not extend either object ;; acextendthisentity Extend obj1 to meet obj2 ;; acextendotherentity Extend obj2 to meet obj1 ;; acextendboth Extend both objects (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; (defun c:bfp ( / rect blocks i l p1 rot p2 p3) (princ "\nSelect blocks: ") (setq blocks (ssget (list (cons 0 "INSERT")))) (setq rect (car (entsel "\nSelect rectangle: "))) ;; I'll extend a line to at least outside the rectangle. Using the length of the rectangle guarantees this (setq len (vla-get-length (vlax-ename->vla-object rect))) (setq i 0) (repeat (sslength blocks) ;; make a dummy line, we'll erase it later (setq l (drawLine (setq p1 (cdr (assoc 10 (entget (ssname blocks i))))) (polar p1 (setq rot (cdr (assoc 50 (entget (ssname blocks i))))) len) )) ;; find intersect with rectangle (setq p2 (nth 0 (LM:intersections (vlax-ename->vla-object l) (vlax-ename->vla-object rect) acextendnone))) (drawPoint p2) (setq p3 (vlax-curve-getPointAtDist (vlax-ename->vla-object l) 25.0)) (drawPoint p3) ;; delete the line (entdel l) (setq i (+ i 1)) ) ) Please try to explain again what exactly you need. block_rect.dwg

@BIGAL toggle with checkbox output can be stored as bit is much convenient, like sysvar example (setvar 'osmode 24) etc.. (defun bits->fix ( l / e ans ) (setq e 0 ans 0) (repeat (length l ) (if (= (nth e (reverse l) ) 1 ) (setq ans (+ (expt 2 e) ans)) ) (setq e (1+ e)) ans ) ) ;(bits->fix '(1 1 1 1 1 0 1 0 0 0) ) 1000 (setq ans (ah:toggs '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))) ("1" "1" "0" "0" "1" "0" "0" "1" "1" "1") ; long output (setq toggs (bits->fix (mapcar 'atoi (reverse ans)) ) 915 suggestion: (mycheckbox strlst toggs)

Have a look for weed.lsp never used it but I think it does what you want.

Why turn it on and off? It must be the type of drawings I do, but I have Polar tracking turned on the whole time. Am I doing it wrong?

I like it! Thanks "tombu" !

How do we know the length between the block insert point and the point you're looking for?

Alternatively, without if statements: (setvar 'snapang (- (rem (+ (getvar 'snapang) (/ pi 2.0)) pi) (/ pi 2.0)))

(if (< (/ pi 2) (getvar 'snapang) (* (/ pi 2) 3)) (setvar 'snapang (+ (getvar 'snapang) pi)))

What version of AutoCAD are you using? If 2017 or above, are you aware of the "gcen" (geometric center) object snap modifier? That would make it easy - no lisp required.

Try the following routine and change the tag name that suits your desired one and regardless of any of the blocks that reside on locked layers. (defun c:Test (/ *error* doc tag lst sel int ent) ;;------------------------------------;; ;; Tharwat - Date: 03.Oct.2019 ;; ;; Change color of a certain attribute;; ;; based on its tag name to by layer. ;; ;;------------------------------------;; (defun *error* (msg) (and doc lst (foreach lay lst (vla-put-lock lay :vlax-true)) ) (and doc (vla-endundomark doc)) (and msg (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*") (princ (strcat "\nError =>: " msg)) ) (princ) ) ;; change the tag to suit yours. (setq tag "My_Tag") ;; ;; (vla-endundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))) ) (vla-startundomark doc) (vlax-for lay (vla-get-layers doc) (and (= (vla-get-lock lay) :vlax-true) (setq lst (cons lay lst)) (vla-put-lock lay :vlax-false) ) ) ;; ;; (and (setq int -1 sel (ssget "_X" '((0 . "INSERT") (66 . 1))) ) (while (setq int (1+ int) ent (ssname sel int) ) (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes) (and (= (strcase (vla-get-tagstring att)) tag) (vla-put-color att AcBylayer) ) ) ) ) (*error* nil) (princ) ) (vl-load-com)

The following will operate autonomously on the active drawing, modifying all attributes with tags matching the supplied pattern at the top of the code (this accepts wildcards): (defun c:fixattcol ( / att atx col idx sel tag ) (setq tag "TAG1" ;; Attribute tag(s) to change col 256 ;; New colour tag (strcase tag) col (list (cons 62 col)) ) (if (setq sel (ssget "_X" '((0 . "INSERT") (66 . 1)))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) att (entnext (ssname sel idx)) atx (entget att) ) (while (= "ATTRIB" (cdr (assoc 0 atx))) (if (wcmatch (strcase (cdr (assoc 2 atx))) tag) (if (entmod (append atx col)) (entupd att) ) ) (setq att (entnext att) atx (entget att) ) ) ) ) (princ) ) You can then run this across multiple drawings using my Script Writer program.

You could make use of my DCL Block Preview function.

Okay (defun c:blss () (pl:block-color-ssget) (princ)) (defun c:blcc () (pl:block-color) (princ)) (defun c:encc () (pl:block-ent-color) (princ)) ;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036 ;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18 (vl-load-com) (defun pl:block-color-ssget (/ adoc blocks color ins lays ss i blocks_done blockname) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) blocks (vla-get-blocks adoc) lays (vla-get-layers adoc) color (acad_colordlg 256) ) (if color (progn (setvar "errno" 0) (vla-startundomark adoc) (setq blocks_done (list)) (princ "\nSelect block objects, then press Enter: ") (while (setq ss (ssget)) ;; (list (cons 0 "INSERT")) (setq i 0) (while (setq ins (ssname ss i)) (if (= "INSERT" (cdr (assoc 0 (entget ins)))) (progn (setq ins (vlax-ename->vla-object ins)) ;; we don't need the car here, because (car (entsel)) removes the pick point ... (if (= (vla-get-objectname ins) "AcDbBlockReference") (if (vlax-property-available-p ins 'path) (princ "\nThis is external reference! Try pick other.") (progn ;; let's skip duplicates (setq blockname (vla-get-name ins)) (if (member blockname blocks_done) ;; if we already did this block, we skip it (progn (princ "\nSkipping block: ") (princ blockname) ) (progn (princ "\n") (setq blocks_done (append blocks_done (list blockname))) (_pl:block-color blocks ins color lays) (vla-regen adoc acallviewports) ) ) ) ) (princ "\nThis isn't block! Try pick other.") ) ) ;; else, put the color to the entity (progn (vla-put-color (vlax-ename->vla-object ins) color) ) ) (setq i (+ i 1)) ) ) ;; / while (vla-endundomark adoc) ) ) (princ) ) (defun pl:block-ent-color (/ adoc blocks color ent lays) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) lays (vla-get-layers adoc) color (acad_colordlg 256) ) (if color (progn (setvar "errno" 0) (vla-startundomark adoc) (while (and (not (vl-catch-all-error-p (setq ent (vl-catch-all-apply (function nentsel) '("\nSelect entity <Exit>:") ) ) ) ) (/= 52 (getvar "errno")) ) (if ent (progn (setq ent (vlax-ename->vla-object (car ent)) lay (vla-item lays (vla-get-layer ent)) ) (if (= (vla-get-lock lay) :vlax-true) (progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false) ) ) (vl-catch-all-apply (function vla-put-color) (list ent color)) (vla-regen adoc acallviewports) ) (princ "\nNothing selection! Try again.") ) ) (foreach i layloc (vla-put-lock i :vlax-true)) (vla-endundomark adoc) ) ) (princ) ) (defun pl:block-color (/ adoc blocks color ins lays) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) blocks (vla-get-blocks adoc) lays (vla-get-layers adoc) color (acad_colordlg 256) ) (if color (progn (setvar "errno" 0) (vla-startundomark adoc) (while (and (not (vl-catch-all-error-p (setq ins (vl-catch-all-apply (function entsel) '("\nSelect block <Exit>:") ) ) ) ) (/= 52 (getvar "errno")) ) (if ins (progn (setq ins (vlax-ename->vla-object (car ins))) (if (= (vla-get-objectname ins) "AcDbBlockReference") (if (vlax-property-available-p ins 'path) (princ "\nThis is external reference! Try pick other.") (progn (_pl:block-color blocks ins color lays) (vla-regen adoc acallviewports) ) ) (princ "\nThis isn't block! Try pick other.") ) ) (princ "\nNothing selection! Try again.") ) ) (vla-endundomark adoc) ) ) (princ) ) (defun _pl:block-color (blocks ins color lays / lay layfrz layloc) (vlax-for e (vla-item blocks (vla-get-name ins)) (setq lay (vla-item lays (vla-get-layer e))) (if (= (vla-get-freeze lay) :vlax-true) (progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false)) ) (if (= (vla-get-lock lay) :vlax-true) (progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false)) ) (vl-catch-all-apply (function vla-put-color) (list e color)) (if (and (= (vla-get-objectname e) "AcDbBlockReference") (not (vlax-property-available-p e 'path)) ) (_pl:block-color blocks e color lays) ) (foreach i layfrz (vla-put-freeze i :vlax-true)) (foreach i layloc (vla-put-lock i :vlax-true)) ) ) (progn (princ "\nBLSS - Changes color of a window selection of blocks") (princ "\nBLCC - Changes color of the chosen blocks") (princ "\nENCC - Changes color of the chosen objects (may be element of the block)") (princ) )

Your Text is annotative, you need to make it non-annotative or read up on using annotative Text. ANNOALLVISIBLE = 1 will allow the text to be visible in the Layout Tab. Your current text is set for a 1:1 scale so they will not show at any other scale with ANNOALLVISIBLE = 0

This Code is from Gilles Chanteau and maybe he will have a newer version. Edit_bloc_3.0_eng.dcl Edit_bloc_3.0_eng.lsp

I also did some code, but my version strictly is doing rectangles in circular path - if there is central one it's also calculated giving bad result, and beside this it's also little buggy...

I have the following, but there are still some bugs -

Consider the following: (defun c:blockdupes ( / ent idx ins lst rtn sel ) (if (setq sel (ssget "_X" '((0 . "INSERT")))) (progn (setq rtn (ssadd)) (repeat (setq idx (sslength sel)) (setq ent (ssname sel (setq idx (1- idx))) ins (cdr (assoc 10 (entget ent))) ) (if (vl-some '(lambda ( x ) (equal ins x 1e-4)) lst) (ssadd ent rtn) (setq lst (cons ins lst)) ) ) (sssetfirst nil rtn) ) ) (princ) ) Note that the code considers blocks to be duplicate based solely on insertion point coordinates which are within 1e-4 (0.0001) units of each other, independent of block name.

(getfiled "Select File" (getvar 'dwgprefix) "" 16) Welcome to CADTutor Daniel

As I remember was the R12 released for DOS, Window and Unix. One of my major customer(a large train manufacture) still works in R12 for Unix to produce electrical diagrams.

Welcome to the forum! There is no way to do that, as far as I know. It would be nice if AutoCAD resized mtext width automatically when you changed the height. Something for the Wish List, I guess....

"; error: no function definition: vlax-get-acad-object" "; error: no function definition: vlax-ename->vla-object" If you find yourself receiving either of these errors, this is an indication that the ActiveX component of the Visual LISP API has not been loaded prior to running a program which relies on this function library. The Visual LISP ActiveX functions may be loaded using the (vl-load-com) function. This function need only be called once per session to ensure the functions are available throughout the drawing session, hence many users will have (vl-load-com) located at the top of their ACADDOC.lsp / ACAD.lsp customisation files so that the expression is automatically evaluated on startup. For this reason, a developer may not notice the omission of this function in their program. If you are receiving one of the above error messages when running a program, first try adding (vl-load-com) on a new-line at the top of the relevant LISP file. Example: Code without (vl-load-com): (defun c:test ( / ) (vlax-get-acad-object) (princ) ) Modified: (vl-load-com) (defun c:test ( / ) (vlax-get-acad-object) (princ) ) If you still receive either of the above errors after reloading the program equipped with (vl-load-com) consider performing a repair or reinstallation of your AutoCAD software, as the Visual LISP ActiveX component can occasionally become corrupted following the installation of an AutoCAD patch. If you are still stuck, search the forums or FAQ for more help.

DEAR SIR, REQUIRE LISP TO WRITE TEXT VALUE ON LINE/PLINE. THE TEXT VALUE I HAVE IN EXCEL THAT IS NOT SAME, I WANT TO WRITE THAT TEXT ON LINE/PLINE AT MID WITH SAME ROTATION OF LINE/PLINE. THANKS SEE IMAGE