Author Topic: cut lines  (Read 6236 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
cut lines
« Reply #30 on: October 07, 2004, 12:34:40 PM »
Change as follows from this
Code: [Select]
     (initget "Y N")
      (setq ans (getkword "\n Do you wish to trim the lines now ? (Y or N) <N>"))
      (if (= ans "Y")

to this
Code: [Select]
     ;;(initget "Y N")
      ;;(setq ans (getkword "\n Do you wish to trim the lines now ? (Y or N) <N>"))
      (if T

Or remove all these lines
Code: [Select]
     (initget "Y N")
      (setq ans (getkword "\n Do you wish to trim the lines now ? (Y or N) <N>"))
      (if (= ans "Y")
        (progn

       <keep lines here>

        ) ; progn
      ) ;_ endif
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ELOQUINTET

  • Guest
cut lines
« Reply #31 on: October 07, 2004, 01:36:33 PM »
bingo that's it thanks you very much for your help cab i really appreciate it

hyposmurf

  • Guest
cut lines
« Reply #32 on: October 08, 2004, 06:27:03 PM »
Quote
Hey HypoSmurf, I have one I wrote a while back that does what you need. Check this out and let me know:

Thanks PDJ it does work but I have a slight probelm with it.When Im asked to indicate trim planes I have to guess the location of my trim planes,either side of the line.Both trim planes will be the same offset distance from the the line theyre parallel to.Its like I have two intersecting lines and I need to cut for example 50mm off each side of one of the lines at the point of intersection.

Code:
;;; Lisp to draw Single or Double "Z" Break Lines
;;;                 A.Henderson 2002
;;;
;;;  Modified By Charles Alan Butler  10/02/2004
;;;  To allow any angle and to trim lines that
;;;  do not run through both break symbols
;;;

(defun c:dz (/ oldlay oldotho oldosmode ztype dist ang
             e1 e2 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10)
  ;; return vertex list by MP
  (defun cdrs (key lst / pair rtn)
    (while (setq pair (assoc key lst))
      (setq rtn (cons (cdr pair) rtn)
            lst (cdr (member pair lst))
      )
    )
    (reverse rtn)
  ) ; defun

  ;;  set osnaps ON/OFF
  (defun setosnaps (value) ; value = "ON" or default to "OFF"
    (if value
      (setq value (strcase value))
    )
    (cond
      ((or (and (= value "ON") (>= (getvar "osmode") 16383))
           (and (/= value "ON") (<= (getvar "osmode") 16383))
       )
       (setvar "osmode" (boole 6 (getvar "osmode") 16384))
      )
    )
  ); defun

  ;;   Start of routine  ==================================
  ;;  Save settings
  (setq oldlay    (getvar "clayer")
        oldortho  (getvar "orthomode")
        oldosmode (getvar "osmode")
  ) ;_ end of setq
  ;;  I use current layer - CAB
  ;;(command ".layer" "make" "Z-Line" "Colour" "41" "" "")

  (initget "S D")
  (setq ztype (getkword "\n Single or Double -^v-^v- ? (S or D) <S>"))
  (setosnaps "ON") ; force on
  ;;===========================================
  (if (and (setq p1 (getpoint "Starting point of break line : "))
           (setq p6 (getpoint p1 "End point of break line : "))
      )
    (progn;===========================================
      (setvar "plinewid" 0)
      (cond
        ((/= ztype "D") ; default to single
         (setq dist (distance p1 p6)
               ang  (angle p1 p6)
               p2   (polar p1 ang (* 0.4167 dist))
               p5   (polar p1 ang (* 0.5833 dist))
               p3   (polar p2 (+ 1.25664 ang) (* 0.1667 dist))
               p4   (polar p5 (+ 4.39824 ang) (* 0.1667 dist))
         ) ;_ end of setq
         (setosnaps "OFF") ; force off
         (command "pline" p1 p2 p3 p4 p5 p6 "") ; Draw the Z-Line
        ) ;_ end cond "S"

        ;;===========================================
        ((= ztype "D")
         (setq p10  p6
               dist (/ (distance p1 p6) 2.0)
               ang  (angle p1 p6)
               p2   (polar p1 ang (* 0.4167 dist))
               p5   (polar p1 ang (* 0.5833 dist))
               p3   (polar p2 (+ 1.25664 ang) (* 0.1667 dist))
               p4   (polar p5 (+ 4.39824 ang) (* 0.1667 dist))
               p6   (polar p5 ang (* 0.8334 dist))
               p9   (polar p6 ang (* 0.1661 dist))
               p7   (polar p6 (+ 1.25664 ang) (* 0.1667 dist))
               p8   (polar p9 (+ 4.39824 ang) (* 0.1667 dist))
         ) ;_ end of setq
         (setosnaps "OFF") ; force off
         (command "pline" p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 "") ; Draw the Z-Line
        ) ;_ end cond
      ) ; end cond stmt

      ;;  Position the second break line
      (setq e1 (entlast))
      (command ".pedit" e1 "L" "ON" "")
      (command ".copy" e1 "" (getvar "lastpoint") pause)
      (setq e2 (entlast))

      ;;  trim function
      (initget "Y N")
      (setq ans (getkword "\n Do you wish to trim the lines now ? (Y or N) <N>"))
      (if (= ans "Y")
        (progn
          (setq evl1 (cdrs 10 (entget e1)) ; ent vertex list
                evl2 (cdrs 10 (entget e2))
                ang1 (angle p1 (car evl2))
                ang2 (angle (car evl2) p1)
          )
          (setq lst  '()
                dist (/ dist 70.0)
          )
          (foreach x evl1
            (setq lst (cons (polar x ang1 1) lst))
          )
          (foreach x (reverse evl2)
            (setq lst (cons (polar x ang2 1) lst))
          )
          (setosnaps "OFF") ; force off
          (command ".trim" e1 e2 "" "F")
          (apply 'command lst)
          (command "" "")
        ) ; progn
      ) ;_ endif


    ) ; progn
  ) ; endif
  ;;================
  ;;  Exit sequence
  ;;================\
  ;;  Restore settings
  ;;  I use current layer - CAB
  ;;(command ".layer" "set" oldlay "")
  (setvar "orthomode" oldortho)
  (setvar "osmode" oldosmode)
  (princ)
) ;_ end of defun
(prompt
  "\nDouble Break Symbol Creator loaded.  Type DZ to run it."
)
(princ)
Thanks to Hendy to.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
cut lines
« Reply #33 on: October 08, 2004, 07:08:58 PM »
hyposmurf
I modified this routine to trim 50 units eather side of a picked line.
If you upload a DWG file of the before trim and after trim, perhaps we can get colser to what you want.
Code: [Select]
;;  Trims at an offset distance from line or lwpline
;;  Select th line, enter an amount say 5
;;  Trims all crossing lines within 5 units of eather side
;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(vl-load-com)

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:trimoff (/ en1 ed1 obj1 ssstpt enpt etype lst)
 ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun 2dvararray->list (a / l lst c)
  (setq c 0)
  (setq l (vlax-safearray->list (vlax-variant-value a)))
  (setq len (length l))
  (while (< c (- len 1))
    (setq lst (append lst (list (list (nth c l) (nth (+ c 1) l)))))
    (setq c (+ 2 c))
  )
  lst
)
 ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 (while (= etype nil)
    (setq en1
  (car
    (entsel "\nSelect line or polyline to remain continuous: ")
  )
    )
    (setq ed1 (entget en1))
    (setq etype (cdr (assoc 0 ed1)))
    (if (and (/= etype "LINE") (/= etype "LWPOLYLINE"))
      (progn
(princ "\n*** You must select a Line or LWPolyline ***")
(setq etype nil)
      )
    )
  )
  ;;======================================================
  ;; This section changed, remove comments to allow choice of gap
  ;;(setq thru_gap (cond (thru_gap) (50))); default gap
  ;;(setq ans (getdist (strcat "\nGap spacing" " <" (rtos thru_gap) ">: ")))
  ;;(setq thru_gap (cond ((> ans 0) ans) (thru_gap))); set gap
  (setq thru_gap 50.0) ; Hyposmurf chose this value, delete this line
  ;;======================================================
  (setq obj1 (vlax-ename->vla-object en1))
  (setq sa1 (vla-offset obj1 thru_gap))
  (setq sa2 (vla-offset obj1 (* thru_gap -1)))
  (setq obj2 (vlax-safearray-get-element (vlax-variant-value sa1) 0))
  (setq obj3 (vlax-safearray-get-element (vlax-variant-value sa2) 0))
  (cond
    ((= etype "LINE")
     (setq stpt (vlax-safearray->list
 (vlax-variant-value
   (vla-get-startpoint obj1)
 )
)
     )
     (setq enpt (vlax-safearray->list
 (vlax-variant-value
   (vla-get-endpoint obj1)
 )
)
     )
     (setq lst (list stpt enpt))
    )
    ((= etype "LWPOLYLINE")
     (setq coords (vla-get-coordinates obj1))
     (setq lst (2dvararray->list coords))
    )
  )
  (setq ss (ssadd))
  (ssadd (vlax-vla-object->ename obj2) ss)
  (ssadd (vlax-vla-object->ename obj3) ss)
  (setvar "cmdecho" 0)
  (command "trim" ss "")
  (command "f")
  (apply 'command lst)
  (command "" "")
  (setvar "cmdecho" 1)
  (vla-delete obj2)
  (vla-delete obj3)
  (princ)
)
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

hyposmurf

  • Guest
cut lines
« Reply #34 on: October 09, 2004, 11:43:30 AM »
No need to upload a drawing I think youve hit the nail on the head CAB.Cheers :dood: What is the top section for (2dvararray->list ) ?Just another way of skinny that cat?Cant get it to work,firstly it brings up my units dialogue box and then when I add 2DVARARRAY->LIST to the command line it doesnt recognise it.Thanks anyway I have what I need,but Im just curious.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
cut lines
« Reply #35 on: October 09, 2004, 12:02:09 PM »
It is a subroutine for the main function, should have been localized.
See the code above, I moved it.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
cut lines
« Reply #36 on: October 09, 2004, 12:15:53 PM »
See here    
   
Code: [Select]
(setq coords (vla-get-coordinates obj1))
     (setq lst (2dvararray->list coords))

the vla-get-coordinates returns the coordinates in a list but the trim command
needs the list to be a point list. The 2dvararray->list converts this
Code: [Select]
(-145.23 163.22 -93.8048 202.378 -54.624 179.128 6.59602 203.601 34.7572 183.411)
to this
Code: [Select]
((-145.23 163.22)(-93.8048 202.378)(-54.624 179.128)(6.59602 203.601)(34.7572 183.411))
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

hyposmurf

  • Guest
cut lines
« Reply #37 on: June 12, 2005, 05:23:30 AM »
Just got back to this one! :roll: Ive managed to run through the lisp and modify it to do what I want.

Code: [Select]
;;  Trims at an offset distance from line or lwpline
;;  Select the line, enter an amount say 5
;;  Trims all crossing lines within 5 units of eather side
;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(vl-load-com)

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:trimoff (/ en1 ed1 obj1 ssstpt enpt etype lst)
 ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun 2dvararray->list   (a / l lst c)
  (setq c 0)
  (setq l (vlax-safearray->list (vlax-variant-value a)))
  (setq len (length l))
  (while (< c (- len 1))
    (setq lst (append lst (list (list (nth c l) (nth (+ c 1) l)))))
    (setq c (+ 2 c))
  )
  lst
)
 ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

 (while (= etype nil)
    (setq en1
      (car
        (entsel "\nSelect line or polyline to remain continuous: ")
      )
    )
    (setq ed1 (entget en1))
    (setq etype (cdr (assoc 0 ed1)))
    (if   (and (/= etype "LINE") (/= etype "LWPOLYLINE"))
      (progn
   (princ "\n*** You must select a Line or LWPolyline ***")
   (setq etype nil)
      )
    )
  )
  (setq thru_gap (cond (thru_gap) (10))); default gap user can modify
  (setq ans (getdist (strcat "\nGap spacing" " <" (rtos thru_gap) ">: ")))
  (setq thru_gap (cond ((> ans 0) ans) (thru_gap))); set gap
  ;;======================================================
  (setq obj1 (vlax-ename->vla-object en1))
  (setq sa1 (vla-offset obj1 thru_gap))
  (setq sa2 (vla-offset obj1 (* thru_gap -1)))
  (setq obj2 (vlax-safearray-get-element (vlax-variant-value sa1) 0))
  (setq obj3 (vlax-safearray-get-element (vlax-variant-value sa2) 0))
  (cond
    ((= etype "LINE")
     (setq stpt   (vlax-safearray->list
        (vlax-variant-value
          (vla-get-startpoint obj1)
        )
      )
     )
     (setq enpt   (vlax-safearray->list
        (vlax-variant-value
          (vla-get-endpoint obj1)
        )
      )
     )
     (setq lst (list stpt enpt))
    )
    ((= etype "LWPOLYLINE")
     (setq coords (vla-get-coordinates obj1))
     (setq lst (2dvararray->list coords))
    )
  )
  (setq ss (ssadd))
  (ssadd (vlax-vla-object->ename obj2) ss)
  (ssadd (vlax-vla-object->ename obj3) ss)
  (setvar "cmdecho" 0)
  (command "trim" ss "")
  (command "f")
  (apply 'command lst)
  (command "" "")
  (setvar "cmdecho" 1)
  (vla-delete obj2)
  (vla-delete obj3)
  (princ)
)
)


Ive removed the comments as CAB noted in his additional comments so I can choose the offset distance.Ive chosen 10 units in this case.
As simple as that modification is thought Id add it so any other dumb arses like myself arent scratching their head for a while trying to work it out.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
cut lines
« Reply #38 on: June 12, 2005, 09:30:02 AM »
With the new talk about vlax-curve- I changed the code to use it.

Code: [Select]
;;  Trims at an offset distance from line or lwpline
;;  Select the line, enter an amount say 5
;;  Trims all crossing lines within 5 units of eather side
;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(vl-load-com)

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(defun c:trimoff (/ en1 ed1 obj1 ssstpt enpt etype lst)
  ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  (defun 2dvararray->list (a / l lst c)
    (setq l   (vlax-safearray->list (vlax-variant-value a))
          len (length l)
          c   0
    )
    (while (< c (- len 1))
      (setq lst (append lst (list (list (nth c l) (nth (+ c 1) l)))))
      (setq c (+ 2 c))
    )
    lst
  )
  ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

  (while (= etype nil)
    (setq en1 (entsel "\nSelect line or polyline to remain continuous: "))
    (if (or (null en1)
            (and (setq ed1 (entget (setq en1 (car en1))))
                 (setq etype (cdr (assoc 0 ed1)))
                 (/= etype "LINE")
                 (/= etype "LWPOLYLINE")
            )
        )
      (progn
        (princ "\n*** You must select a Line or LWPolyline ***")
        (setq etype nil)
      )
    )
  )
  (setq thru_gap (cond (thru_gap)
                       (10)
                 )
  ) ; default gap user can modify
  (setq ans (getdist (strcat "\nGap spacing" " <" (rtos thru_gap) ">: ")))
  (setq thru_gap (cond ((> ans 0) ans)
                       (thru_gap)
                 )
  ) ; set gap

  ;;======================================================
  ;;  Offset the object
  (setq obj1 (vlax-ename->vla-object en1))
  (setq sa1 (vla-offset obj1 thru_gap))
  (setq sa2 (vla-offset obj1 (* thru_gap -1)))
  ;;  get the new objects
  (setq obj2 (vlax-safearray-get-element (vlax-variant-value sa1) 0))
  (setq obj3 (vlax-safearray-get-element (vlax-variant-value sa2) 0))
  ;;  get the end points
  (cond
    ((= etype "LINE")
     (setq lst (list (vlax-curve-getstartpoint obj1)
                     (vlax-curve-getendpoint obj1)
               )
     )
    )
    ((= etype "LWPOLYLINE")
     (setq coords (vla-get-coordinates obj1))
     (setq lst (2dvararray->list coords))
    )
  )
  ;;  Make ss the boundaries, lst will be the fence
  (setq ss (ssadd))
  (ssadd (vlax-vla-object->ename obj2) ss)
  (ssadd (vlax-vla-object->ename obj3) ss)
  (setvar "cmdecho" 0)
  (command "trim" ss "")
  (command "f")
  (apply 'command lst)
  (command "" "")
  (setvar "cmdecho" 1)
  (vla-delete obj2)
  (vla-delete obj3)
  (princ)
)


edit: fixed a bug I introuduced.
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

hyposmurf

  • Guest
Re: cut lines
« Reply #39 on: September 30, 2005, 05:45:17 PM »
Although I really rate this lisp,one problem I do encounter is that when its implemented on a line/polyline it will carry out a trim either side of this line on objects out of the screen along the entire length of the line/polyline.Problem with that is when you have a busy drawing its not always to see what has been cut when your zoomed into a area.Is there a way to just isolate the lisp to focus on one are or say just two crossing lines?

Andrea

  • Water Moccasin
  • Posts: 2372
Re: cut lines
« Reply #40 on: October 05, 2005, 12:58:22 PM »
Hi,...

I have created this routine for endpipe..
but you can use-it and change the end block as you wish.

Keep smile...