extrim command
hi
I use a lot the command EXTRIM of AUTOCAD, specially to extract some area from a city plan or something like that, using a poliline as limit of the desired area. With Extrim only I do two clicks and ready.
I can not do this with bricscad, if somebody has a lisp routine to do this will be great for me.
thanks a lot
0
Comments
-
You can try this. It is a work in progress.
(defun c:EET (/ *error* initial_set point1 point2 temp_set touching_set counter1)
(defun *error* (message)
(and message
(not (wcmatch (strcase message) "*BREAK*,*CANCEL*,*QUIT*"))
(princ (strcat "\nError: " message))
)
(command "._undo" "end")
)
(defun dxf (1code 1ent) (cdr (assoc 1code 1ent)))
(defun delta (a1 a2 / r1)
(cond
((> a1 (+ a2 pi))
(setq a2 (+ a2 (* 2.0 pi)))
)
((> a2 (+ a1 pi))
(setq a1 (+ a1 (* 2.0 pi)))
)
)
(setq r1 (- a2 a1))
(if (< r1 0.0)
(setq r1 (+ r1 (* 2.0 pi)))
)
r1
)
(defun VxGetTangentAtPoint (Obj Pnt / CurPar PntLst TmpPnt)
(setq PntLst (VxGetEndPoints Obj)
CurPar (cond
((equal Pnt (car PntLst) 1E-5)
(vlax-curve-getStartParam Obj)
)
((equal Pnt (cadr PntLst) 1E-5)
(vlax-curve-getEndParam Obj)
)
((setq TmpPnt (vlax-curve-getClosestPointTo Obj Pnt))
(if (<= (distance TmpPnt Pnt) 1E-5)
(vlax-curve-getParamAtPoint Obj TmpPnt)
)
)
(T nil)
)
)
(if CurPar
(angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv Obj CurPar))
)
)
(defun VxGetEndPoints (Obj)
(list
(vlax-curve-getStartPoint Obj)
(vlax-curve-getEndPoint Obj)
)
)
(defun left_test (ls_object ls_point / temp_point temp_point2)
(setq temp_point (vlax-curve-getClosestPointTo
ls_object
ls_point
)
)
(setq normal (- (VxGetTangentAtPoint
ls_object
temp_point
)
(/ pi 2.0)
)
)
(if (< normal 0.0)
(setq normal (+ normal (* pi 2.0)))
)
(setq delta_angle (delta normal (angle temp_point ls_point)))
(if (or (< delta_angle (/ pi 2.0))
(> delta_angle (* 3.0 (/ pi 2.0)))
)
(setq side nil)
(setq side T)
)
side
)
(defun get_point (gp_point gp_object gp_trimmer_object gp_left /)
(entmake (list (cons 0 "CIRCLE") ; make a circle with radius 0.01
(cons 6 "CONTINUOUS")
(cons 8 "POWER")
(cons 10 gp_point)
(cons 39 0.0)
(cons 40 0.01)
; (cons 60 1)
(cons 62 2)
(cons 210 (list 0.0 0.0 1.0))
)
)
(setq bounds (entlast)) ; get the circle
(setq bounds_entity (entget (entlast))) ; get the circle's entity
(setq counter 0)
(setq gp_inters_list (vlax-invoke ; check for intersection object
(vlax-ename->vla-object (dxf -1 bounds_entity))
'IntersectWith
gp_object
acExtendNone
)
)
(entdel bounds)
(setq gp_inters_points nil)
(if gp_inters_list ; if there are intersections ...
(progn
(repeat (/ (length gp_inters_list) 3) ; convert the data to points
(setq gp_inters_points (cons (list (car gp_inters_list)
(cadr gp_inters_list)
(caddr gp_inters_list)
)
gp_inters_points
)
)
(setq gp_inters_list (cdddr gp_inters_list))
)
(setq point1 (car gp_inters_points)) ; there is at least one point
(if (> (length gp_inters_points) 1)
(setq point2 (cadr gp_inters_points)) ; get the second point if there is one ..
(setq point2 nil) ; or set the second point to nil
)
(if (/= point1 nil) ; left_test will error if the point is nil
(if (= (left_test trimmer_object point1) gp_left) ; point1 same side as trim side?
point1 ; yes, return point1
(progn ; no ...
(if point2 ; is there a point2?
point2 ; yes, return point2
nil ; no, return nil
)
)
)
)
)
nil
)
)
(defun do_trim (dt_trimmer_object dt_object_ename dt_intersection_list dt_left_side / )
(setq dt_intersection_list_points nil)
(setq dt_object (vlax-ename->vla-object dt_object_ename))
(if dt_intersection_list ; if there are intersections ...
(progn
(repeat (/ (length dt_intersection_list) 3) ; convert the data to points
(setq dt_intersection_list_points (cons (list (car dt_intersection_list)
(cadr dt_intersection_list)
(caddr dt_intersection_list)
)
dt_intersection_list_points
)
)
(setq dt_intersection_list (cdddr dt_intersection_list))
)
(foreach memb dt_intersection_list_points
(progn
(setq dt_intersection_point memb)
(setq dt_point3 (get_point dt_intersection_point ; intersection point
dt_object ; object to trim
dt_trimmer_object ; "trim to" object
dt_left_side ; "trim to" side
)
)
(if (/= dt_point3 nil)
(progn
(setq dt_trim_list (list (vlax-vla-object->ename dt_object) dt_point3))
(command "trim" (vlax-vla-object->ename dt_trimmer_object) "" dt_trim_list "")
)
)
)
)
)
)
)
(vl-load-com)
(command "._undo" "end")
(command "._undo" "begin")
(setq trimmer_selected nil)
(while (= trimmer_selected nil)
(setq trimmer_selected (entsel "\nSelect trimming edge: ")) ; get the "trim to" selection
(setq trimmer_entity (entget (car trimmer_selected))) ; get the "trim to" entity
(if (and (/= (cdr (assoc 0 trimmer_entity)) "LINE") : only accept these types
(/= (cdr (assoc 0 trimmer_entity)) "ARC")
(/= (cdr (assoc 0 trimmer_entity)) "SPLINE")
(/= (cdr (assoc 0 trimmer_entity)) "LWPOLYLINE")
(/= (cdr (assoc 0 trimmer_entity)) "POLYLINE")
(/= (cdr (assoc 0 trimmer_entity)) "CIRCLE")
(/= (cdr (assoc 0 trimmer_entity)) "ELLIPSE")
)
(setq trimmer_selected nil) ; try again if necessary
)
)
(setq trimmer_ename (cdr (assoc -1 trimmer_entity))) ; get the "trim to" ename
(redraw trimmer_ename 3) ; highlight the "trim to" selection
(setq trimmer_object (vlax-ename->vla-object trimmer_ename)) ; get the "trim to" object
(setq side_point (getpoint "\nSelect trimmed side: "))
(setq left_side (left_test trimmer_object side_point))
(vla-getboundingbox trimmer_object 'point1 'point2) ; get the bounding box for the "trim to" selection
(setq point1 (vlax-safearray->list point1) ; get the bounding box points
point2 (vlax-safearray->list point2)
)
(setq temp_set (ssget "_C" ; get entities in the bounding box into temp_set
(trans (list (car point1) (cadr point2) 0.) 0 1)
(trans (list (car point2) (cadr point1) 0.) 0 1)
)
)
(ssdel (car trimmer_selected) temp_set)
(while (> (sslength temp_set) 0) ; while there are entities in temp_set ...
(setq object (vlax-ename->vla-object (ssname temp_set 0))) ; get the first entity
(if (setq intersection_list (vlax-invoke ; check for intersection with the "trim to" entity
trimmer_object
'IntersectWith
object
acExtendNone
)
)
(do_trim trimmer_object (ssname temp_set 0) intersection_list left_side)
; trim the crossing entity
)
(ssdel (ssname temp_set 0) temp_set) ; delete entity from temp_set
)
(command "._undo" "end")
(princ)
)
(defun printss (ss / counter)
(setq counter 0)
(while (< counter (sslength ss))
(print (entget (ssname ss counter)))
(setq counter (1+ counter))
)
)0 -
hi Martin
very nice routine, works very good with no big plans, but when I used in a plan with a lot of level curves, like a topographic plan this error appears:
Select trimmed side:
Error: Automation Error 80020009; Error accessing [INTERSECTWITH] method. ErrIndex=0
: ._undo
Undo: Mark/Back to mark/BEgin set/End set/Control/Auto/<Number of steps to undo>: end
:
Cancelyou routine works, but I do not know why appears this error, I hope you continue working in this very nice routine.
regards
0 -
With this Google search:
autolisp cookie cutter "Permission to use, copy, modify, and distribute this software"You can find a version of EXTRIM which still has the "friendly" AutoCAD copyright notice:
http://bbs.mjtd.com/thread-28699-1-1.html0 -
The version of EXTRIM at the bbs.mjtd.com site appears to be missing several lines.
0 -
hi Roy
thanks for the link, I found a routine but gives the next error:
Cannot find AC_BONUS.LSP
looks like an error for a application from autocad 14, but I could not find a solution.
;;;
;;; EXTRIM.LSP - Written by Randy Kintzley
;;;
;;; Copyright (C) 1997 by Autodesk, Inc.
;;;
;;; 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.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Functions created as result of loading file: extrim.lsp
; ANOTHER_OFFSET
; ETRIM
; GET_FENCE_POINTS
; INTERSECT_CHECK
; TRUNCATE_2_VIEW
;
;Variables created as result of loading file: extrim.lsp
;
;Functions created as a result of executing the commands in: extrim.lsp
;
;Variables created as a result of executing the commands in: extrim.lsp
; BONUS_ALIVE
; BONUS_OLD_ERROR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;GLOBAL INFO.;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;Extended-TRIM - cookie-cutter routine
;
;Select a polyline, line, circle or arc and a side to trim on
;
(defun c:et ( / dxf na p1 redraw_it) (if (and (not init_bonus_error)
(equal -1 (load "ac_bonus.lsp" -1))
);and
(progn (alert "Error:\n Cannot find AC_BONUS.LSP.")(exit))
);if
(init_bonus_error (list
(list "cmdecho" 0
"highlight" 0
"regenmode" 1
"osmode" 0
"ucsicon" 0
"offsetdist" 0
"attreq" 0
"plinewid" 0
"plinetype" 1
"gridmode" 0
"celtype" "CONTINUOUS"
)
T ;flag. True means use undo for error clean up.
'(if redraw_it (redraw na 4))
);list
);init_bonus_error ;local function
(defun dxf (a b / ) (cdr (assoc a b)));defun (princ "\nPick a POLYLINE, LINE, CIRCLE, or ARC for cutting edge..")
(setq na (single_select '((-4 . "<OR")
(0 . "CIRCLE")
(0 . "ARC")
(0 . "LINE")
(0 . "LWPOLYLINE")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<NOT")
(-4 . "&")
(70 . 112)
(-4 . "NOT>")
(-4 . "AND>")
(-4 . "OR>")
)
T
);single_select
);setq
(if na
(progn
;(setq e1 (entget na));;setq
(redraw na 3)
(setq redraw_it T) (setq p1 (getpoint "\nPick the side to trim on:"));setq
(redraw na 4)
(setq redraw_it nil) (if p1 (etrim na p1));if
);progn
);if (restore_old_error)
(princ)
);defun c:extrim ;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
;Entity-TRIM function
;takes: na - entity name
; a - a point, the side to trim on
;NOTE: This function does not allow for the possible miss of
; non-continuous linetypes.
;
(defun etrim ( na a / la dxf b d e1 lst lst2 n j k m ss na2 na3 na4
x y z flag flag2 flag3
) ;local function
(defun dxf (a b / ) (cdr (assoc a b)));defun (setq e1 (entget na));setq
(if (or (setq flag (equal (dxf 0 e1) "POLYLINE"))
(setq flag (equal (dxf 0 e1) "LWPOLYLINE"))
(equal (dxf 0 e1) "LINE")
(equal (dxf 0 e1) "CIRCLE")
(equal (dxf 0 e1) "ARC")
);or
(progn
(if (and flag
(equal 8 (logand 8 (dxf 70 e1)))
);and
(setq flag nil)
);if
(setq a (trans a 1 0));setq
(command "_.ucs" "_View")
(setq lst (ep_list na nil) ;;;find extents of selected cutting edge object
lst (maxminpnt lst)
x (- (car (cadr lst)) (car (car lst)))
y (- (cadr (cadr lst)) (cadr (car lst)))
x (* 0.075 x)
y (* 0.075 y)
z (list x y)
x (list (+ (car (cadr lst)) (car z))
(+ (cadr (cadr lst)) (cadr z))
);list
y (list (- (car (car lst)) (car z))
(- (cadr (car lst)) (cadr z))
);list
);setq
(command "_.zoom" "_w" x y)
(entupd na) ;;;update the ent. so it's curves display smoothly (setq lst (ep_list na
(/ (pixel_unit) 2.0)
)
);setq
(if (or (not flag)
(not (p_isect lst nil))
);or
(progn ;then the object is valid and not a self intersecting polyline.
(if (and flag
(equal (car lst) (last lst) 0.0001)
);and
(setq flag3 T);then the polyline could potentialy need a second offset
);if
(if (setq la (b_layer_locked (getvar "clayer")))
(command "_.layer" "_unl" (getvar "clayer") "")
);if
(command "_.pline")
(setq b nil)
(setq n 0);setq
(repeat (length lst)
(setq d (nth n lst))
(if (not (equal d b 0.0001))
(progn
(command d)
(setq lst2 (append lst2 (list d)));setq
(setq b d);setq
);progn
);if
(setq n (+ n 1))
);repeat
(command "")
(setq na2 (entlast)
ss (ssadd)
ss (ssadd na2 ss)
lst nil
);setq
(ss_visible ss 1)
(setq lst2 (get_fence_points na2 a lst2 flag3 flag));setq
(if la
(command "_.layer" "_lock" (getvar "clayer") "")
);if
(command "_.ucs" "_p")
;Move the ents to force a display update of the ents to avoid viewres problems.
(setvar "highlight" 0)
(if (setq ss (ssget "f" (last lst2)))
(command "_.move" ss "" "0,0,0" "0,0,0")
);if
(if flag
(progn
(if (setq la (b_layer_locked (dxf 8 e1)))
(command "_.layer" "_unl" (dxf 8 e1) "")
);if
(ucs_2_ent (dxf 210 e1))
(command "_.copy" na "" "0,0,0" "0,0,0")
(entdel na)
(setq na3 na
na (entlast)
);setq
(command "_.pedit" na "_w" "0.0" "_x")
(command "_.ucs" "_p")
(if la (command "_.layer" "_lock" (dxf 8 e1) ""));if
);progn
);if
(command "_.trim" na "")
(setq m (- (length lst2) 1));setq
(setq k 0) ;@rk
(repeat (length lst2)
(setq lst (nth k lst2))
(setq a (trans (car lst) 0 1))
(setq n 1)
(repeat (- (length lst) 1) ;repeat each fence list
(setq b (trans (nth n lst) 0 1))
(if (equal a b 0.0001)
(setq flag2 T)
(setq flag2 nil)
);if
(setq na4 nil);setq
(setq j 0);setq
(while (not flag2) ;repeat each segment of the fence until no new ents are created.
(setq na4 (entlast));setq
(command "_F" a b "")
(if (and (equal na4 (entlast))
(or (not (equal k m))
(> j 0)
);or
);and
(setq flag2 T)
);if
(setq j (+ j 1));setq
);while
(setq a b);setq
(setq n (+ n 1));setq
);repeat
(setq k (+ k 1))
);repeat
(command "")
(if flag
(progn
(if (setq la (b_layer_locked (dxf 8 e1)))
(command "_.layer" "_unl" (dxf 8 e1) "")
);if
(entdel na) ;get rid of the copy
(entdel na3);bring back the original
(if la (command "_.layer" "_lock" (dxf 8 e1) ""));if
);progn
);if
);progn
(progn
(command "_.ucs" "_p")
(princ "\nSelf intersecting edges are not acceptable.")
);progn else invalid self intersecting polyline
);if
(command "_.zoom" "_p")
);progn then it's a most likely a valid entity.
);if
);defun etrim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun another_offset ( pl1 pl2 a1 a2 b na2 lst2 a lst3 lst4 / na ss lst da1 da2) (setq da1 (abs (- a2 a1)));setq
(setq da2 (- (* b (max pl2 pl1))
(/ (* b (abs (- pl2 pl1)))
2.0
)
)
);setq
(if (> (abs (- da2 da1))
(* 0.01 (max a1 a2))
)
(progn (pline (list lst2))
(setq na (entlast)
na2 (entlast)
ss (ssadd)
ss (ssadd na ss)
);setq
(ss_visible ss 1)
(command "_.offset" b na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (vtlist (entlast)))
(setq lst3 (intersect_check lst2 lst3 lst4))
);and
(progn
(ss_visible (ssadd (entlast) (ssadd)) 1)
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
(setq lst (list (vtlist (list (entlast) 0))));setq
(entdel (entlast));then offset was a success so delete the ent after getting it's info
);progn then
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(entdel na2)
);progn then let's do that second offset
);if lst
);defun another_offset ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun get_fence_points ( na2 a lst2 flag plflag / a1 a2 pl1 pl2 b c d n
lst lst2 lst3 lst4 na
) (if flag
(progn
(setq lst2 (cdr lst2));setq
(repeat (fix (/ (length lst2) 2))
(setq lst2 (append (cdr lst2) (list (car lst2)));append
);setq
);repeat
(setq lst2 (append lst2 (list (car lst2))));setq
(command "_.area" "_ob" na2)
(setq pl1 (getvar "perimeter")
a1 (getvar "area")
);setq
);progn
);if (setq a (trans a 0 1)
b (* (getvar "viewsize") 0.05);initial offset distance
n 3.0 ;number of offsets
d (/ b (- n 1)) ;delta offset
c (pixel_unit)
lst4 (viewpnts)
);setq (while (> b c)
(setq na (entlast))
(command "_.offset" b na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (vtlist (entlast)))
(or (not plflag)
(setq lst3 (intersect_check lst2 lst3 lst4))
);or
);and
(progn
(setq lst3 (lsttrans lst3 1 0))
(ss_visible (ssadd (entlast) (ssadd)) 1)
(if flag
(progn
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
);progn
);if
(setq lst (append lst (list lst3)));setq
(entdel (entlast)) ;delete the ent after getting it's vertex info
(if flag
(setq lst (append lst
(another_offset pl1 pl2 a1 a2 b na2 lst2 a lst3 lst4)
);append
);setq
);if
);progn then offset was a success
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(setq b (- b d));setq
);while
(setq na (entlast))
(command "_.offset" c na2 a "")
(if (and (not (equal na (entlast)))
(setq lst3 (vtlist (entlast)))
(or (not plflag)
(setq lst3 (intersect_check lst2 lst3 lst4))
);or
);and
(progn
(setq lst3 (lsttrans lst3 1 0))
(ss_visible (ssadd (entlast) (ssadd)) 1)
(if flag
(progn
(command "_.area" "_ob" (entlast))
(setq pl2 (getvar "perimeter")
a2 (getvar "area")
);setq
);progn
);if
(setq lst (append lst (list lst3)));setq
(entdel (entlast));then offset was a success so delete the ent after getting it's info
(if flag
(setq lst (append lst
(another_offset pl1 pl2 a1 a2 c na2 lst2 a lst3 lst4)
);append
);setq
);if
);progn then
(if (not (equal na (entlast))) (entdel (entlast)));if else
);if
(entdel na2) lst
);defun get_fence_points ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;returns a list of points on screen if the first two lists do not
;contain segments that intersect each other.
;
(defun intersect_check ( lst lst2 lst3 / x x2 y y2 lst4 flag len len2
a aa b bb c d n j) (setq len (length lst)
len2 (length lst2)
x (car (car lst3))
x2 (car (cadr lst3))
y (cadr (car lst3))
y2 (cadr (cadr lst3))
);setq (setq n 0);setq
(while (and (not flag)
(< (+ n 1) len2)
);and
(setq aa (nth n lst2)
bb (nth (+ n 1) lst2)
a (truncate_2_view aa bb x y x2 y2)
b (truncate_2_view bb aa x y x2 y2)
lst4 (append lst4 (list a))
);setq
(if (or (not (equal a aa))
(not (equal b bb))
);or
(setq lst4 (append lst4 (list b)))
);if
(setq j 0);setq
(while (and (not flag)
(< (+ j 1) len)
);and
(setq c (nth j lst)
d (nth (+ j 1) lst)
flag (inters a b c d)
);setq (setq j (+ j 1));setq
);while (setq n (+ n 1));setq
);while
(if (not (equal b (last lst4)))
(setq lst4 (append lst4 (list b)));setq
);if
(if (not flag)
(setq flag lst4)
(setq flag nil)
);if
flag
);defun intersect_check ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun truncate_2_view ( a b x y x2 y2 / int)
(if (and (< (car a) x)
(setq int (inters a b (list x y 0.0) (list x y2 0.0)))
);and
(setq a int)
(if (and (> (car a) x2)
(setq int (inters a b (list x2 y 0.0) (list x2 y2 0.0)))
);and
(setq a int)
);if else
);if
(if (and (< (cadr a) y)
(setq int (inters a b (list x y 0.0) (list x2 y 0.0)))
);and
(setq a int)
(if (and (> (cadr a) y2)
(setq int (inters a b (list x y2 0.0) (list x2 y2 0.0)))
);and
(setq a int)
);if else
);if a
);defun truncate_2_view
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\n \"EXTRIM\" loaded.")
(princ)0 -
Sorry about that: I should have tested the code from the link.
Here's another link:
http://www.theswamp.org/index.php?topic=24646.0;all
This is CookieCutter2 by Joe Burke. You may have to join the Swamp to be able to download the files. Note that there is an updated version in post #23. Please also read post #34: it is a 2D routine so it will not work if your level curves have a z elevation.
I have tested this time ;-) and it works OK for me.0 -
My code was failing when it tried to break an inserted block. Around line 206 change the (setq temp_set ... to this:
Cookie Cutter 2 by Joe Burke is an excellent routine that I recommend, but it only accepts closed entities as trimming entities. I needed a routine that would use a line as the trimmimg entity.(setq temp_set (ssget "_C" ; get entities in the bounding box into temp_set
(trans (list (car point1) (cadr point2) 0.) 0 1)
(trans (list (car point2) (cadr point1) 0.) 0 1)
'((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))
)
)0 -
Hi Martin
again, thank you very much really, and Roy, thanks to you too, also you routine help me a lot, thanks guys.
Only I need to check if these routines work in bricscad linux that I use in the office.
thanks again
0 -
Hi Martin
sorry to bother you again. your routine works great in bricscad windows, but not in bricscad linux, if you could help me making workable this routine in bricscad linux I will appreciate it very much.
This is the error or the routine in bricscad linux V11.
: eet
: ._undo
Undo: Mark/Back to mark/BEgin set/End set/Control/Auto/<Number of steps to undo>: end
: ._undo
Undo: Mark/Back to mark/BEgin set/End set/Control/Auto/<Number of steps to undo>: begin
Select trimming edge:
Select trimmed side:
; ----- LISP Error : Call Stack -----
; [0]...C:EET <<--
;
; ----- Error around expression -----
(VLA-GETBOUNDINGBOX TRIMMER_OBJECT 'POINT1 'POINT2)
;
Error: no function definition <VLA-GETBOUNDINGBOX> at [EVAL]
: ._undo
Undo: Mark/Back to mark/BEgin set/End set/Control/Auto/<Number of steps to undo>: end0 -
The error message says that VLA-GETBOUNDINGBOX is not implimented in the Linux version of Bricscad that you have. I do not have a Linux computer here to test with.
0 -
BTW:
If the segment you want to cut out is rectangular using the fence or crossing option in the trim command can already be a great time-saver.0
This discussion has been closed.