Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 12/09/2022 in all areas

  1. If you are happy to pick an attribute directly then can do this. Uses Nentsel rather than entsel. (setq attstr (cdr (assoc 1 (entget (car (nentsel "\nPick attribute "))))))
    1 point
  2. another (defun LM:vl-getattributevalue ( blk tag );LEE MAC (setq tag (strcase tag)) (vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes)) ) (defun c:sel_block () (while (setq obj_block (vlax-ename->vla-object (car (entsel "\nSelecciona bloque: ")))) (setq dato2 (LM:vl-getattributevalue obj_block "DATO2")) (princ dato2) ) )
    1 point
  3. getproperyvalue doesn't work in BricsCAD so I can't test this. This will ask you to select a block and if it has DAT2 attribute it will 1 set variable x to its value (can be called later) 2 copy that value to the clipboard (ctr+V to paste) (defun C:foo (/ html) (vl-load-com) (if (setq x (getpropertyvalue (car (entsel "\nSelect Block")) "DAT2")) (vlax-invoke (vlax-get (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" x) ) (vlax-release-object html) (princ) )
    1 point
  4. Updated the if statement to ignore block names that start with a "*" this will ignore anonymous blocks like xref and dimensions. (defun c:AllToByBlock (/ doc b o SS blk) (vl-load-com) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-for b (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (if (/= (vl-string-elt (vla-get-name b) 0) 42) (vlax-for o b (vla-put-Color o 0) ;change all elements inside block to byblock ) ) ) (if (setq SS (ssget "_X" '((0 . "INSERT")))) (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq blk (vlax-ename->vla-object blk)) (vla-put-Color blk 200) ) ) (vla-regen doc acAllViewports) (princ) )
    1 point
  5. Sorry should have said i updated my code above to work.
    1 point
  6. I think they had like splines half way thought that were hidden or frozen making the drawing super huge like 400mb. I found a lisp that kept the top level block but burst all nested levels once that was done and splines deleted and purged the drawing was like 2mb (think it was lee mac's) Set drawing limits in the middle of no where (or really small) (setvar 'LIMCHECK 1) "Why can't i create anything the layer isn't locked!!@#@!#?"
    1 point
  7. Not saying its what they are doing but sometimes contractors want to do the work in house, but are told to send what they have to a third party. so they make it as difficult as possible to work on the drawings. I once had a drawing sent to me that had over 200 nested levels for every block (over 1000) for no reason.
    1 point
  8. 1000 identical trees each saved as a unique block definition (with possibly the only difference being the base point)? Got to love a contractor who supplies drawings like that
    1 point
  9. The trees have came in from an external survey company and was just trying to hatch the canopy of the tree. So instead of hatching each individual tree I was looking to create one block with the hatched canopy and replace all the other blocks which are inherently different. I do have a tree block that's dynamic which scales to the canopy size, but for this job I just used the existing block. I think @mhupp may have what I was looking.
    1 point
  10. ah yes , have'nt thought about that one. Just switch of layer mode , type in any string for blockname , same for attributes and switch back to layer mode, maybe this will work. I will fix this later.
    1 point
  11. had an idea (not necessarily a good one) but tried to add search for layers to a program I wrote a little while back My BFF. Have only tested it once though so hope for the best & plan for the worst... (1) Put Routine in layer mode , add names of layer(s) to search for. (2) Save the search list (3) select folder with drawings to scan (4) click on create (5) click on ok you should get new dialog with drawings containing layers you specified (if any). You can click on one item in list box and full path is displayed below the list box. You can then click on ok to open the drawing , or click on edit button to open notepad with list of all drawings found. You can also click on multiple lines in the listbox and click ok. Hope it works, if not , will try to fix later... RlxMyBFF.lsp
    1 point
  12. Me again with some more details. here is the array, "big enough" for the outline. What I forgot to say: make the rectangles just a litle bit smaller as you need them, so in the array they doesen't touch each-other Here is my outline, converted to region too That's what I get after using the INTERSECT command, followed by EXPLODE This is what quickselect returned and finaly the final result. Maybe I should have saved a copy of the outline before I converted it to region...
    1 point
  13. OK, I tested it again with more calm and it worked PERFECT, EXCELLENT, it was VERY GOOD, CONGRATULATIONS. Tested with LINE and TEXTs worked. Tested with LINE and MTEXTs it worked. Tested with PLINE and TEXTs worked. Tested with PLINE and MTEXTs worked. Includes a line for lists to always start empty: Fix the line that asks for OFFSET as a comment and includes a snippet so that OFFSET is automatic using the height of the text: Here is the modified code:
    1 point
  14. I guess that in that case, you don't need offset at all... Quickly written, and untested... (defun c:maketextreadable ( / _aap l lines p2 ss text dxf50 xx minp maxp mp pp d ) (vl-load-com) ;; RJP » 2021-10-06 ;; MR » 2021-01-11 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (= 8 (logand 8 (getvar 'undoctl))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_M") (if (setq ss (ssget '((0 . "*polyline,Line,*Text")))) (progn (or (setq d (getdist "\nEnter offset distance <0> : ")) (setq d 0)) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (and (wcmatch (cdr (assoc 0 (setq xx (entget x)))) "*TEXT") (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 xx)))))))) (setq text (cons x text)) (if (not (wcmatch (cdr (assoc 0 xx)) "*TEXT")) (setq lines (cons x lines)) ) ) ) (if lines (foreach x text (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp) (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp))) (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp)) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x mp)) (distance mp p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (setq dxf50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) (caddr l) ) ) (entupd (cdr (assoc -1 (entmod (subst (cons 50 dxf50) (assoc 50 (setq xx (entget x))) xx))))) (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp) (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp))) (setq pp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp)) (vla-move (vlax-ename->vla-object x) (vlax-3d-point pp) (vlax-3d-point mp)) (vla-move (vlax-ename->vla-object x) (vlax-3d-point mp) (vlax-3d-point (car l))) (vla-move (vlax-ename->vla-object x) (vlax-3d-point (car l)) (vlax-3d-point (polar (car l) (angle (car l) mp) d))) ) ) ) ) ) ) (vl-cmdf "_.UNDO" "_E") (princ) )
    1 point
×
×
  • Create New...