ggs_1689 Posted April 19, 2013 Posted April 19, 2013 Is there a way to create a lips program or a vba macro to offset a line on both sides, keep the source, then trim all the content between the two offset lines and delete them. Or is there a way to create the same effect around a MLeader? Something like the described on the attached imaged Quote
Tharwat Posted April 19, 2013 Posted April 19, 2013 Welcome to CadTutor Try this code ... (defun c:test (/ *error* dxf s ss of obj in nm lst p) ;;--- Tharwat 19. April. 2013 ---;; (defun *error* (x) (setvar 'cmdecho 1) (princ (strcat "\n Error ... " x)) ) (defun dxf (n o) (cdr (assoc n (entget o)))) (if (and (progn (princ "\n Select single line ... >> ") (setq s (ssget "_+.:S:L" '((0 . "LINE")))) ) (setq ss (ssget "_X" '((0 . "LINE")))) (setq of (getdist "\n Specify offset distance :")) ) (progn (setq obj (vlax-ename->vla-object (ssname s 0))) (repeat (setq in (sslength ss)) (if (not (eq 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (dxf 8 (setq nm (ssname ss (setq in (1- in))))) ) ) ) ) ) ) ) (setq lst (cons nm lst)) ) ) (setvar 'cmdecho 0) (foreach e lst (if (and (setq p (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone ) ) (> (distance (dxf 10 e) (dxf 11 e)) (* of 2.)) ) (command "_.break" e "_none" (vlax-curve-getclosestpointto e (polar p (angle (dxf 10 e) (dxf 11 e)) of) ) "_none" (vlax-curve-getclosestpointto e (polar p (angle (dxf 11 e) (dxf 10 e)) of) ) ) ) ) (setvar 'cmdecho 1) ) ) (princ "\n Written by Tharwat Al Shoufi") (princ) ) (vl-load-com) Quote
pBe Posted April 20, 2013 Posted April 20, 2013 (edited) (defun c:demo (/ s ss space pntlst TempL p p1 p2) (vl-load-com) (setq space (vlax-get (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object) ) ) 'Block ) ) (if (and (setq s (ssget "_+.:S:L" '((0 . "[b]MULTILEADER[/b]")))) (setq s (vlax-ename->vla-object (ssname s 0))) (setq width (cond ((getdist (strcat "\nEnter width " (if width (strcat " <" (rtos width) ">: ") ": ") )))(width)) ) (setq w (* 0.5 width)) ) (progn (setq pntlst (vlax-invoke s 'GetLeaderLineVertices 0 ) zv (nth 2 pntlst) ) (setq TempL (vlax-invoke space 'AddLightweightPolyline (vl-remove-if '(lambda (l) (= zv l)) pntlst) )) (setq ss (ssget "_:L")) (repeat (setq i (sslength ss)) (if (setq p (vlax-invoke TempL 'IntersectWith (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ) acExtendNone ) ) (progn (setq p1 (vlax-curve-getpointatDist e (- (vlax-curve-getDistAtPoint e p) w)) p2 (vlax-curve-getpointatDist e (+ (vlax-curve-getDistAtPoint e p) w) ) ) (command "_break" (ssname ss i) "_non" p1 "_non" p2) ) ) ) (vla-delete TempL) ) )(princ) ) Edited April 20, 2013 by pBe Quote
BIGAL Posted April 22, 2013 Posted April 22, 2013 A bit more elaborate, cut multiples say follow a pline, pretty easy, offset pline in 2 directions remember these objects, then trim obj1 obj2 "F" pick original pline all done erase obj1 obj2. A lisp makes this easy and transparent. Quote
pBe Posted April 22, 2013 Posted April 22, 2013 (edited) That is what i had in mind before until i saw that the "cutting edges" is a MLEader: Anyhoo. a quick one for lines (defun c:test ( / s ss width) (if (and (setq s (ssget "_+.:S:L" '((0 . "LINE")))) (setq s (vlax-ename->vla-object (ssname s 0)) ss (ssadd) ) (setq width (getdist "\nEnter width: ")) ) (progn (vlax-invoke s 'offset (- (* 0.5 width))) (ssadd (entlast) ss) (vlax-invoke s 'offset (* 0.5 width)) (ssadd (entlast) ss) (command "_trim" ss "" "_Fence" "_non" (vlax-get s 'StartPoint) "_non" (vlax-get s 'EndPoint) "" ) (command "_erase" ss "" "") ) )( princ) ) Edited April 22, 2013 by pBe Paren.. sent to room :) Quote
GP_ Posted April 22, 2013 Posted April 22, 2013 DWG unfortunate... with a wipeout would not be mutilated. Quote
pBe Posted April 22, 2013 Posted April 22, 2013 DWG unfortunate... with a wipeout would not be mutilated. GP_, I dont know what that means Quote
Tharwat Posted April 22, 2013 Posted April 22, 2013 @ pBe . The last paren of your post # 5 ran out of the code tags . Quote
pBe Posted April 22, 2013 Posted April 22, 2013 @ pBe . The last paren of your post # 5 ran out of the code tags . How did it get there. bad.. bad parenthesis... Quote
GP_ Posted April 22, 2013 Posted April 22, 2013 (edited) GP_, I dont know what that means I mean, maybe you do not need to cut all the objects if you just cover them with a wipeout. Remember to set Frames = Off (defun c:demo (/ s s1 ss space pntlst w pntlst zv TempL TempL1 TempL2 Lv L1v L2v ) (vl-load-com) (setq space (vlax-get (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object) ) ) 'Block ) ) (if (and (princ "\nSelect MLeader") (setq s (ssget "_+.:S:L" '((0 . "MULTILEADER")))) (setq s (vlax-ename->vla-object (setq s1 (ssname s 0)))) (setq width (cond ((getdist (strcat "\nEnter width " (if width (strcat " <" (rtos width) ">: ") ": ") )))(width)) ) (setq w (* 0.5 width)) ) (progn (setq pntlst (vlax-invoke s 'GetLeaderLineVertices 0 ) zv (nth 2 pntlst) ) (setq TempL (vlax-invoke space 'AddLightweightPolyline (vl-remove-if '(lambda (l) (= zv l)) pntlst) ) ) (vlax-invoke TempL 'offset (- (* 0.5 width))) (setq TempL1 (entlast)) (vlax-invoke TempL 'offset (* 0.5 width)) (setq TempL2 (entlast)) (setq Lv1 (coo TempL1) Lv2 (coo TempL2) Lv (append Lv1 (reverse Lv2)) ) (setq os (getvar 'osmode)) (setvar 'osmode 0) (command "_.wipeout") (apply 'command Lv) (command "") (setvar 'osmode os) (command "_.draworder" s1 "" "_F") (vla-delete TempL) (entdel TempL1) (entdel TempL2) ) ) ) (defun Coo ( a / coor) (mapcar '(lambda (x) (if (eq (car x) 10) (setq coor (cons (list (cadr x) (caddr x)) coor)) ) ) (entget a) ) coor ) Edited April 23, 2013 by GP_ Quote
pBe Posted April 22, 2013 Posted April 22, 2013 I mean, maybe you do not need to cut all the objects if you just cover them with a wipeout. Nice Idea GP_ Quote
EBROWN Posted April 22, 2013 Posted April 22, 2013 GP.... This works Great. What code is needed to also include leader or qleader. Quote
GP_ Posted April 22, 2013 Posted April 22, 2013 ...What code is needed to also include leader or qleader. To be completed with the error handling. Naturally it works with straight leader line. The real challenge would be to connect a reactor (for the wipeout) to mleader, but it is a work for guru, not for me. (defun c:demo (/ s s1 ss space pntlst pntlst1 w pntlst zv s_name TempL TempL1 TempL2 Lv L1v L2v ) (vl-load-com) (setq space (vlax-get (vla-get-ActiveLayout (vla-get-activedocument (vlax-get-acad-object) ) ) 'Block ) ) (if (and (princ "\nSelect Leader or MLeader") (setq s (ssget "_+.:S:L" '((0 . "*LEADER")))) (setq s (vlax-ename->vla-object (setq s1 (ssname s 0)))) (setq s_name (vlax-get s 'ObjectName)) (setq width (cond ((getdist (strcat "\nEnter width " (if width (strcat " <" (rtos width) ">: ") ": ") )))(width)) ) (setq w (* 0.5 width)) ) (progn (cond ( (eq s_name "AcDbMLeader" ) (setq pntlst (vlax-invoke s 'GetLeaderLineVertices 0 ) ;zv (nth 2 pntlst) ) (setq pntlst1 nil) (repeat (/ (length pntlst) 3) (setq pntlst1 (cons (list (car pntlst) (cadr pntlst)) pntlst1)) (setq pntlst (cdddr pntlst)) ) (setq pntlst pntlst1) ) ( (eq s_name "AcDbLeader" ) (mapcar '(lambda (x) (if (eq (car x) 10) (setq pntlst (cons (list (cadr x) (caddr x)) pntlst)) ) ) (entget s1) ) ) ) (setq TempL (vlax-ename->vla-object (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pntlst)) ) (mapcar '(lambda (x) (cons 10 x)) pntlst) ) ) ) ) (vlax-invoke TempL 'offset (- (* 0.5 width))) (setq TempL1 (entlast)) (vlax-invoke TempL 'offset (* 0.5 width)) (setq TempL2 (entlast)) (setq Lv1 (coo TempL1) Lv2 (coo TempL2) Lv (append Lv1 (reverse Lv2)) ) (setq os (getvar 'osmode)) (setvar 'osmode 0) (command "_.wipeout") (apply 'command Lv) (command "") (setvar 'osmode os) (command "_.draworder" s1 "" "_F") (vla-delete TempL) (entdel TempL1) (entdel TempL2) ) ) ) (defun Coo ( a / coor) (mapcar '(lambda (x) (if (eq (car x) 10) (setq coor (cons (list (cadr x) (caddr x)) coor)) ) ) (entget a) ) coor ) Quote
ggs_1689 Posted June 25, 2013 Author Posted June 25, 2013 Hello Tharwat, I tried your code and works great. But it only works over lines. Do you think it's possible for it to work over circles, splines, arcs and so on? Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.