TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Dommy2Hotty on September 20, 2004, 10:26:14 AM
-
Two lines cross (not always horizontal or vertical lines). At the point where they cross, one of the lines needs to be trimmed/broke at 1/16" on either side of the other line. Here's what I got so far to get their intersection point...at a loss of where to go from here...
(defun c:pipetrim (/ line1 line2 l1 l2 pt1 pt2 pt3 pt4 intpt)
(setq line1 (entsel "Select Line to STAY....."))
(setq line2 (entsel "Select Line to TRIM....."))
(setq l1 (entget (car line1))
pt1 (cdr (assoc 10 l1))
pt2 (cdr (assoc 11 l1))
)
(setq l2 (entget (car line2))
pt3 (cdr (assoc 10 l2))
pt4 (cdr (assoc 11 l2))
)
(setq intpt (inters pt1 pt2 pt3 pt4 nil))
(princ)
)
-
Check out the XCR proggie here (http://www.resourcecad.com/programs/)
-
Thanks...gives me an idea of another way to go...
-
I would create a 3 point ucs (with the lines you have already selected) using the point list "intpt" as <0.0 0.0 0.0> and pt1 and pt3 as the x and y values for your 3 point ucs.
"BREAK" the lines where you want them and switch back to the WCS.
-
(defun DTR (D) (/ (* D PI) 180.0))
(setq hm '(0.0 0.0 0.0))
(setq b1 (polar hm (dtr 180) 0.0625))
(setq b2 (polar hm (dtr 180) -0.0625))
b1 & b2 could be your break points or you can manipulate them depending on which line you pick first and the way you orient your 3 point ucs
-
Using a UCS is a pretty ugly way of doing that. It only works on lines, and it may not work right if your lines are not perpendicular. Routines should generally not change the UCS, unless that is part of the purpose of the routine. In most cases, you shouldn't change to a temporary UCS for calcs in a Lisp routine; there's probably a better way of approaching the problem if you think about it a bit. (The primary exception is when you want to switch to the OCS of a given entity to simplify some complex calculation.)
How about this? Select the line you want to break, and then the centerpoint of your break (not the crossing line). Works on any applicable entity (line, arc, polyline, etc.). I have you pick the entity first as the simple way of dealing with overlapping entities.
; mb.lsp v1.00
; Richard Sincovec 9/23/04
; Creates a measured break around pick point
(defun c:mb (/ entity brkpt endd d1 d2 osmode)
(if (null mb:width)
(setq mb:width 0.0625) ; default value
) ;_ if
(setq mb:width
(cond
((getdist
(strcat
"\nDistance to trim from either side of pick point <"
(rtos mb:width)
">: "
) ;_ strcat
) ;_ getdist
)
(mb:width)
) ;_ cond
) ;_ setq
(while (setq entity (car (entsel "\nSelect entity: ")))
(if
(setq brkpt (getpoint "\nSelect point to break: "))
(progn
(setq brkpt (vlax-curve-getDistAtPoint
entity
(vlax-curve-getClosestPointTo entity brkpt)
) ;_ vlax-curve-getDistAtPoint
endd (vlax-curve-getDistAtPoint
entity
(vlax-curve-getEndPoint entity)
) ;_ vlax-curve-getDistAtPoint
d1 (- brkpt mb:width)
d2 (+ brkpt mb:width)
) ;_ setq
(if (< d1 0)
(setq d1 0)
) ;_ if
(if (< endd d2)
(setq d2 endd)
) ;_ if
(setq osmode (getvar "osmode")) ;_ setq
(setvar "osmode" 0)
(command "break"
(list entity (vlax-curve-getPointAtDist entity d1))
(vlax-curve-getPointAtDist entity d2)
) ;_ command
(setvar "osmode" osmode)
) ;_ progn
) ;_ if
) ;_ while
(princ)
) ;_ defun
-
Huh works for me....
(defun c:ptr ()
(defun DTR (D) (/ (* D PI) 180.0))
(setq hm '(0.0 0.0 0.0))
(setq b1 (polar hm (dtr 180) 0.0625))
(setq b2 (polar hm (dtr 180) -0.0625))
(setvar "osmode" 2048)
(setq ip (getpoint "\nSelect intersection"))
(setvar "osmode" 512)
(setq line1 (getpoint "\nSelect line to remain whole"))
(setq line2 (getpoint "\nSelect line to break"))
(command "ucs" "3" ip line2 line1 "")
(command "break" b1 b2 "")
(command "ucs" "world")
(setvar "osmode" 0)
(princ)
)
-
Here's one I built a long time ago, dunno if it still works:
;;;start GAPM
(defun etype (E)
(setq E (Cdr (assoc 0 (entget (car E)))))
)
(defun askdist (R S / R S ANS)
(setq ANS nil)
(if (= R nil)
(progn
(while (or (= ANS "") (= ANS nil))
(princ (strcat S ": "))
(setq ANS (getdist))
)
(setq R ANS)
)
(progn
(princ (strcat S " <" (rtos R) ">: "))
(setq ANS (getdist))
(if (or (= ANS nil) (= ANS ""))
(setq R R)
(setq R ANS)
)
)
)
R
)
(defun C:GAPM (/ cline cle clm entg ente entm intpt hgap)
(setq cline (entsel "\nSelect LINE to remain continuous: "))
(if (null cline)
(prompt "\n Nothing Selected, Try again..")
(progn
(setq gapd (askdist gapd "\nGap Distance"))
(if
(or
(= (etype cline) "POLYLINE")
(= (etype cline) "LINE")
(= (etype cline) "LWPOLYLINE")
)
(progn
(setvar "cmdecho" 0)
(setvar "highlight" 0)
(setq cle (osnap (cadr cline) "endp")
clm (osnap (cadr cline) "midp")
)
(setq entg (entsel "\nEntity to gap: "))
(while entg
(setq ente (osnap (cadr entg) "endp")
entm (osnap (cadr entg) "midp")
)
(setq intpt (inters cle clm ente entm nil)
hgap (/ gapd 2.0)
)
(command "break" (cadr entg) "F" (polar intpt (angle ente entm) hgap)
(polar intpt (angle entm ente) hgap)
)
(setq entg (entsel "\nEntity to gap: "))
)
)
(prompt "Entity not a line")
)
)
)
(setvar "cmdecho" 1)
(setvar "highlight" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun etype (E)
(setq E (Cdr (assoc 0 (entget (car E)))))
)
(defun askdist (R S / R S ANS)
(setq ANS nil)
(if (= R nil)
(progn
(while (or (= ANS "") (= ANS nil))
(princ (strcat S ": "))
(setq ANS (getdist))
)
(setq R ANS)
)
(progn
(princ (strcat S " <" (rtos R) ">: "))
(setq ANS (getdist))
(if (or (= ANS nil) (= ANS ""))
(setq R R)
(setq R ANS)
)
)
)
R
)
(SETQ GAPD (* 0.125 (GETVAR "DIMSCALE")))
-
Here's another variation of the above, the first gaps each line as it's selected, this one uses a crossing window and gaps all selected. Both of them only work on lines I think.
(SETQ GAPD (* 0.125 (GETVAR "DIMSCALE")))
(defun C:EGAP (/ cline cle clm entg osm ls pck no e1 e2 ente entm intpt hgap)
(setq cline (entsel "\nSelect LINE to remain continuous: "))
(if (null cline)
(prompt "\n Nothing Selected, Try again..")
(progn
(setq gapd (askdist gapd "\nGap Distance"))
(if
(or
(= (etype cline) "POLYLINE")
(= (etype cline) "LINE")
)
(progn
(setvar "cmdecho" 0)
(command "undo" "m")
(SETQ OSM (GETVAR "OSMODE")) ;
(SETVAR "OSMODE" 0) ;
(setq cle (osnap (cadr cline) "endp")
clm (osnap (cadr cline) "midp")
)
(prompt "entities to gap: ") ;
(setq entg (ssget) ;
ls (sslength entg) ;
) ;
; (setq pck (getvar "pickbox")) ;
; (setvar "pickbox" 3) ;
(setq no -1) ;
(repeat ls ;
(setq no (1+ no)) ;
(setq e1 (list (ssname entg no))) ;
(setq e2 (entget (car e1))) ;
(setq ente (cdr (assoc 11 e2))) ;
(setq entm (cdr (assoc 10 e2))) ;
(setq intpt (inters cle clm ente entm nil)
hgap (/ gapd 2.0)
)
(command "break" (POLAR INTPT (ANGLE ENTE ENTM) HGAP);
(polar intpt (angle entm ente) hgap))
)
)
(prompt "Entity not a line")
)
)
)
;(setvar "pickbox" pck) ;
(SETVAR "OSMODE" OSM) ;
(setvar "cmdecho" 1)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
Routines should generally not change the UCS, unless that is part of the purpose of the routine.
Huh?
......Well all I can say is there is more than one way to scin a cat.