Topic: Lisp for creating gap at intersection

[yellowplanet]

Hi there,

I'm trying to find a lisp routine to break a vertical line at the intersection with a horizontal line, leaving a gap.

I've been looking around for a while and have only come across routines which break at the intersect point.

I'm sure I had a lisp routine years ago that did this.

I've attached (hopefully) a little diagram showing what I'd like the routine to do.

Thanks for any help,

YP

[qjchen]

I search and get this

Jeff_M 's code maybe meet your need.
http://groups.google.com/group/autodesk.autocad.customization/browse_thread/thread/ed03f2ba9b6979dc/96dd09d4d54f2110?lnk=gst&q=break+gap&rnum=1#96dd09d4d54f2110

Adesu and Menzi also done this work.
http://groups.google.com/group/autodesk.autocad.customization/browse_thread/thread/4c40c1c178ca848a/c52aeaab6a536806?lnk=gst&q=break+gap&rnum=3#

In China, wkai has ever done like this, but the code is not open.
http://www.xdcad.net/forum/showthread.php?threadid=213437

[yellowplanet]

Cheers mate!

The first link was exactly what I needed.

I knew I should have come here earlier rather than waste loads of time trying to find something myself.

Again, thanks,

YP

[Arizona]

Jeff_M is also a member here

[Jeff_M]

Jeff_M is also a member here

Where?

[TimSpangler]

Weird, Ijust updated this last week.  It might help

Code: [Select]

;;; ------------------------------------------------------------------------
;;;    GAPLINE.LSP
;;;
;;;    Copyright © July, 2007
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;; ------------------------------------------------------------------------

;;; MAIN FUNCTION ;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:GAPLINE (/ OldCmdEcho OldOsmode GapDist SelEnt EntName IntersectPoint TempObj
 TempCirc TempIntersect Point1 Point2)

;; Load active-x extension
(vl-load-com)
;; Set system variables
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOsmode (getvar "OSMODE"))
;; Set undo marker
(command "_undo" "BEGIN")
;; Set osmode to NEAREST
(setvar "osmode" 512) 
;; Set gap distance
(if (not(setq GapDist  (getreal "\n Enter Gap Distance: <6>")))
(setq GapDist 6.0)
)
;; Select line to gap
(while (null(setq SelEnt (entsel "\n Select object to gap")))
(princ "\n Missed - Select object")
)
;; Get Entity name
(setq EntName (car SelEnt))
;; Check entity for type
(if (or
(= (cdr (assoc 0 (entget EntName))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget EntName))) "POLYLINE")
(= (cdr (assoc 0 (entget EntName))) "LINE")
                               [color=red](= (cdr (assoc 0 (entget EntName))) "CIRCLE")[/color]
)
(progn
;; Highlight selected entity
(redraw EntName 3)
;; Set snaps to NEAREST INTERSECT
(setvar "OSMODE" 544)
;; Get interstion point
(while (null (setq IntersectPoint (getpoint "\n Select Intersection ")))
(princ "\n No intersection found - Select intersection")
)
;; Create vlaobj from selected entity
(setq TempObj (vlax-ename->vla-object EntName))
;; Create temp circle
(entmake
(list
(cons 0 "CIRCLE")
(cons 6 "BYLAYER")
(cons 8 "0")
(cons 10 IntersectPoint)
(cons 39 0.0)
(cons 40 (/ GapDist 2.0))
(cons 62 256)
(cons 210 (list 0.0 0.0 1.0))
)
)
;; Create vlaobj from circle
(setq TempCirc (vlax-ename->vla-object (entlast)))
;; Get intersect points from selected line and temp circle
(if (null (setq TempIntersect (vlax-invoke TempObj 'intersectwith TempCirc acExtendBoth)))
(progn
;; Delete temp circle
(vlax-invoke TempCirc 'delete)
;; Unhighlight selected line
(redraw EntName 4)
;; Reset system variables
(setvar "OSMODE" OldOsmode)
(setvar "CMDECHO" OldCmdEcho)
;; Silent exit
(alert "\n No intersection found")
(exit)
)
)
;; Create list of points
(setq Point1 (list (nth 0 TempIntersect)(nth 1 TempIntersect)(nth 2 TempIntersect)))
(setq Point2 (list (nth 3 TempIntersect)(nth 4 TempIntersect)(nth 5 TempIntersect)))
;; Unhighlight selected line
(redraw EntName 4)
;; Break selected line at gap distance
(command "break" EntName Point1 Point2)
;; Delete temp circle
(vlax-invoke TempCirc 'delete)
)
(progn
(alert "Object selected is not a Line or Polyline")
;; Unhighlight selected line
(redraw EntName 4)
;; Reset system variables
(setvar "OSMODE" OldOsmode)
(setvar "CMDECHO" OldCmdEcho)
;; Silent exit
(princ)
(exit)
)
)
;; Reset undo marker
(command "_undo" "END")
;; Reset system variables
(setvar "OSMODE" OldOsmode)
(setvar "CMDECHO" OldCmdEcho)
;; Silent exit
(princ)
)

Just noticed that it didn't gap circles 

[CaddmannQ]

I tried Jeff_M's code, but always get this error:

Command: ap
APPLOAD brkint.lsp successfully loaded.
Command: ; error: An error has occurred inside the *error* functionAutoCAD
variable setting rejected: "osmode" nil

Any ideas?

[Jeff_M]

I tried Jeff_M's code, but always get this error:

Any ideas?

The code as posted in that thread got an unneeded line feed which placed commented code into the real code area.

Code: [Select]

;;(setq gap2 (if (= gap nil) 0.125 gap))
;;;(setq gap (getreal (strcat "\nEnter Break Gap Distance " "<" (rtos gap2)
">" ": ")))
;;;(if (= gap nil) (setq gap gap2))
  (setq gap 1.5)
should be:

Code: [Select]

;;(setq gap2 (if (= gap nil) 0.125 gap))
;;;(setq gap (getreal (strcat "\nEnter Break Gap Distance " "<" (rtos gap2) ">" ": ")))
;;;(if (= gap nil) (setq gap gap2))
  (setq gap 1.5)


[CaddmannQ]

Thanks, Jeff. 

Works perfectly now.

[Rabbit]

I have a version of this that I've fixed for dealing with endpoints within the temp circle.

Code: [Select]

;;;****Old routine to break gaps at intersecting lines****
;;;;Created  8/11/89 By W. R. Kincaid
;;;;                 PO Box 8085
;;;;                 Greenville, NC 27835
;;;;
;;;;Modified 11/18/04 By Jamie Myers
;;;;    
;;;;
;;;;Modified again 1/7/08 By Jamie Myers
;;;;    
;;;;
;;;;  To allow breaking entities at intersections.
;;;;
;;;;
;;;;  To allow the trimming of entities at intersections.

;;;------------------------------------------------------------------------------------------------
;;;Routines to break lines, arcs and polylines at a point with a gap.

;;; Returns the "block object" for the active space
;;; Thanks to Jason Piercey
;;;(defun activeSpaceObject (document) His Name for it
;;;(defun GetCurrentSpace (Doc / BlkCol SpaceList CurSpace ActSpace temp1)
;;;  (vla-get-block (vla-get-activelayout Doc))
;;;)

;;; Break object at intersection, with ability to place and arc.
;;; Does not work when trying to break a circle.
;;; By Tim Willey 02/2005
;;; Revised by Jamie Myers 02/09/2005
;;; Revised by Jamie Myers 01/28/2011 to allow trimming of objects at intersection


;;;------------------------------------------------------------------------------------------------
(defun c:BGP (/ ActDoc CurSpace DimSc BkPt BkEnt IntPt1 IntPt2 StAng EndAng
                 osm ocmd tmpSc tmpCir tmpIntPts tmpPt tmpArc)
  (vl-load-com)
  (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (vla-StartUndomark ActDoc)
  (defun *BGP*SetupSave ()
    (setvar "cmdecho" 0)
    (setq DimScl (getvar "dimscale"))
    (if (= DimScl 0.0) (setq DimScl (getvar "dimtxt")))
    (setq OrthoMode (getvar "orthomode"))
    (setq OsMode (getvar "osmode"))
    (setq 3DOsMode (getvar "3Dosmode"))
    (setvar "orthomode" 1)
    (setvar "OsMode" 0)
    (setvar "3DOsMode" 0)
  );defun

  (defun *BGP*SetupRestore ()
    (setvar "cmdecho" 1)
    (setvar "orthomode" OrthoMode)
    (setvar "osmode" OsMode)
    (setvar "3Dosmode" 3DOsMode)
    (vla-EndUndoMark ActDoc)
    (redraw)
  );defun
 
;;;------------------------------------------------------------------------------------------------
  (defun *ERROR* (Msg)
    (if (not (member Msg '("console break" "Function cancelled" "quit / exit abort")))
     (princ (strcat "\nError: " Msg))
    );if
  (*BGP*SetupRestore)
  (princ)
  );defun
  (*BGP*SetupSave)
  (setq CurSpace (vla-get-block (vla-get-activelayout ActDoc)))
  (setvar "osmode" 32)
  (if
    (and
      (setq BkEnt (entsel "\n Select object to break: "))
      (setq BkPt (getpoint "\n Select intersection point: "))
    );end and
    (progn
      (setq BkPt (trans BkPt 1 0))
      (setq tmpCir (vla-AddCircle CurSpace (vlax-3d-point BkPt) (* 0.05 DimScl)))
      (setq tmpIntPts (vlax-invoke (vlax-ename->vla-object (car BkEnt)) 'IntersectWith tmpCir acExtendNone))
      (if (or (= (length tmpIntPts) 3) (= tmpIntPts nil))
(progn
  (prompt "\nCannot break object.  Select Objects to trim inside of circle: ")
  (vl-cmdf ".zoom" "_w" (car (setq tmp (acet-ent-geomextents (vlax-vla-object->ename tmpCir)))) (cadr tmp))
  (vl-cmdf ".zoom" ".25xp")
  (command "_.trim" (vlax-vla-object->ename tmpCir) "")
  (while (= (getvar "CMDNAMES") "TRIM")
    (command pause)
  );while
  (vla-Delete tmpCir)
  (vl-cmdf ".zoom" "p")
  (vl-cmdf ".zoom" "p")
);progn
(progn
          (setq IntPt1 (trans (list (car tmpIntPts) (cadr tmpIntPts) (caddr tmpIntPts)) 0 1))
          (setq IntPt2 (trans (cdddr tmpIntPts) 0 1))
  (vla-Delete tmpCir)
          (setvar "osmode" 0)
          (command "_.break" (car BkEnt) IntPt1 IntPt2)
);progn
      );if
    );end progn
  );end if
  (*BGP*SetupRestore)
  (princ)
);end defun


[CAB]

You may find this of interest.
http://www.theswamp.org/index.php?topic=10370.0

[deane]

What a great idea all this code is... so over-needed in this office. Is there a way to create a gap in an Mleader line?, short of using a mask that is?