Jump to content

Recommended Posts

Posted

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

 

3.jpg

1.jpg

2.jpg

Posted

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)

Posted (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 by pBe
Posted

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.

Posted (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 by pBe
Paren.. sent to room :)
Posted

DWG unfortunate... with a wipeout would not be mutilated.

Posted
DWG unfortunate... with a wipeout would not be mutilated.

 

GP_, I dont know what that means :unsure:

Posted

@ pBe .

 

The last paren of your post # 5 ran out of the code tags . :D

Posted
@ pBe .

 

The last paren of your post # 5 ran out of the code tags . :D

 

:rofl: How did it get there. bad.. bad parenthesis...

Posted (edited)
GP_, I dont know what that means :unsure:

 

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

 

429.gif

 

 

(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 by GP_
Posted
I mean, maybe you do not need to cut all the objects if you just cover them with a wipeout.

 

Nice Idea GP_ :)

Posted

GP.... This works Great. What code is needed to also include leader or qleader.

Posted
...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
)

  • 2 months later...
Posted

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?

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...