Leaderboard
Popular Content
Showing content with the highest reputation on 10/28/2019 in all areas
-
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.1 point
-
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 it1 point
-
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.1 point
-
1 point
-
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 next1 point
-
1 point
-
1 point
-
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)1 point
-
@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)1 point
-
1 point