Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/04/2023 in all areas

  1. Haven't had a chance to look at this one, but I'd be tempted to go with recreate the boundary - loads of examples out there for that, then offset but I think you'd need a polyline to offset and make it work well rather than explode to individual lines. perhaps have to look at each vertex, compare with the ones either side to find 2 that are the right length (as above, say, 50) and at right angles to the other - break the polylines here giving 2 ends plus 2 polylines then offset one of them
    1 point
  2. 1. Create a dwg file containing new blocks. 2. Select blocks to be modified using QSELECT or layer filter in the drawing to be modified. 3. Copy with CopyBase (Ctrl+Shift+C) 0,0 4. ERASE and PURGE for Delete Blocks. 5. Insert the DWG file containing the new block into the drawing using XREF. 6. in XREF window INSERT(not BIND) that for merging this will make the new blocks into the original drawing. 7. Paste the CopyBase block from the clipboard with Ctrl+V 0,0 Since the copybased inform contains only the block name, it is pasted as a new block. 8. Delete the inserted XREF. or try this routine ; REPLACEBLOCKS - 2023.09.04 exceed ; Replace existing blocks with duplicate names with copied blocks. (defun c:REPLACEBLOCKS (/ *error* answer ss thisdrawing mspace entl myline ent ssl index bnamelist entp objp objtype bname bnlen recoverlist bnold bntemp rcl 1blk fromname toname ssb n e1 edata ) (vl-load-com) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark thisdrawing) (princ) ) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (setq mspace (vla-get-modelspace thisdrawing)) (vla-startundomark thisdrawing) (princ "\n Replace existing blocks with duplicate names with copied blocks.") (princ "\n you need to copy the block from another drawing and then run this command.") (setq answer (getstring "\n If you already copied, press the space bar / If not, press ESC.")) (setq ss (ssadd)) (if (setq entl (entlast)) (progn) (progn (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1)))) (setq entl (entlast)) (ssadd entl ss) ) ) (setvar 'cmdecho 0) (command "pasteclip" "0,0") (while (setq ent (entnext entl)) (ssadd ent ss) (setq entl ent) ) (setq ssl (sslength ss)) (setq index 0) (setq bnamelist '()) (repeat ssl (setq entp (ssname ss index)) (setq objp (vlax-ename->vla-object entp)) (setq objtype (vlax-get-property objp 'EntityName)) ;(princ objtype) (if (= objtype "AcDbBlockReference") (progn (setq bname (vlax-get-property objp 'effectivename)) (setq bnamelist (cons bname bnamelist)) ) ) (setq index (+ index 1)) ) (setq bnamelist (vl-sort bnamelist '<)) ;(princ bnamelist) (repeat ssl (setq entp (ssname ss 0)) (entdel entp) (ssdel entp ss) ) ;; Unique - Lee Mac ;; Returns a list with duplicate elements removed. (defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))) ) (setq bnamelist (LM:Unique bnamelist)) ;(princ bnamelist) (setq bnlen (length bnamelist)) (setq recoverlist '()) (repeat bnlen (setq bnold (car bnamelist)) (setq index 0) (setq bntemp (strcat bnold "-TEMP")) (while (tblsearch "BLOCK" bntemp) (setq bntemp (strcat bnold "-TEMP" (vl-princ-to-string index))) (setq index (+ index 1)) ) (vla-put-Name (vla-item (vla-get-blocks thisdrawing) bnold) bntemp) (setq recoverlist (cons (list bntemp bnold) recoverlist)) (setq bnamelist (cdr bnamelist)) ) (vla-PurgeAll thisdrawing) (setq ss (ssadd)) (setq entl (entlast)) (if (= entl nil) (progn (setq myline (vla-addline mspace (vlax-3d-point (list 0 0 0))(vlax-3d-point (list 1 1 1)))) (setq entl (entlast)) (ssadd entl ss) ) ) (command "pasteclip" "0,0") (while (setq ent (entnext entl)) (ssadd ent ss) (setq entl ent) ) (repeat ssl (setq entp (ssname ss 0)) (entdel entp) (ssdel entp ss) ) (setq rcl (length recoverlist)) (setq index 0) (repeat rcl (setq 1blk (nth index recoverlist)) (setq fromname (car 1blk)) (setq toname (cadr 1blk)) (if (setq ssb (ssget "_X" (list (cons 2 fromname)))) (repeat (setq n (sslength ssb)) (setq e1 (ssname ssb (setq n (1- n)))) (setq edata (entget e1)) (entmod (subst (cons 2 toname) (cons 2 fromname) edata)) (entupd e1) ) ) (setq index (+ index 1)) ) (command "redraw") (vla-PurgeAll thisdrawing) (setvar 'cmdecho 1) (vla-EndUndoMark thisdrawing) (princ) ) This is a rough routine, so it's not elegant. It's just an idea, so someone better can edit it. how to use it 1. Copy new blocks to copy base. 2. Run REPLACEBLOCKS on the drawing to be replaced. How it Works 1. Paste the copybased items once and add them to the selection set. 2. Since entlast is used to insert into the selection set, a temporary line is created in case entlast does not exist. (although it is almost never necessary...) 3. Collect block names by cycling through the selection set. 4. Filter out unique names. 5. Delete temporarily pasted objects and lines. 6. Find the corresponding block name in the blocks of this drawing. 7. Change the name to one with -TEMP. In case of duplicates, add serial numbers after that -TEMP. 8. Create a list by pairing the original name and TEMP name. To return it to its original state later. 9. Delete the existing block definition with PurgeAll. 10. PasteSpec again and paste the block from the clipboard to create a new definition. and then delete them. 11. Revert to the name changed with entmod. 12. Run purgeall again to delete the TEMP block definition. 13. End Since the temporary block is pasted twice and the temporary line is also created and deleted, it is best to check the area near 0,0 once. It worked fine in my tests, but I didn't assume all the scenarios.
    1 point
  3. Look into using Bpoly. It will make a pline inside your room shape, then you can get the property "area" of the pline created. Some help bpoly I will let you work that out as your learning (setq obj (vlax-ename->vla-object (entlast))) (setq area (vla-get-area obj))
    1 point
  4. You're welcome to use my implementation from here.
    1 point
  5. @robierzo Rather than accepting bit codes other than closed, it may be wiser to reject the closed bit code, as this will continue to function if additional bit codes are added in future. (ssget "_X" '( (-4 . "<OR") (0 . "ARC,LINE") (-4 . "<AND") (0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&=") (70 . 1) (-4 . "NOT>") (-4 . "AND>") (-4 . "OR>") ) )
    1 point
  6. A bit more (defun c:spelv ( / lo hi) (setq ss (ssget (list '(0 . "LWPOLYLINE") '(-4 . ">=") (cons 38 (getreal "enter low value")) '(-4 . "<") (cons 38 (getreal "Enter high value"))))) (command "-chprop" ss "" "La" (getstring "Enter Layer name") "") )
    1 point
×
×
  • Create New...