PDA

View Full Version : extrim - how it works?



inner69923
2004-10-05, 12:25 AM
wanna create command in vba just like 'extrim' but with modifications, so i take a look at the lsp

but i really dont know lisp, so dont know what it does

i would like to know the procedure of this lsp just to start the same in vba
anyone can help?¿ just a basic explanation

*Note: I have removed the attachment. As it infringes on the copyright of Autodesk*
Glenn forum moderator

whdjr
2004-10-05, 11:46 AM
You can get a working procedure and explantion of all parts from the Express Tools.

inner69923
2004-10-05, 05:31 PM
where? the express tools web page? any *.txt of the pack?

whdjr
2004-10-05, 06:52 PM
EXTRIM



Trims all objects at the cutting edge specified by a selected Polyline, Line, Circle, Arc, Ellipse, Text, mtext, or Attribute Definition.

Command: EXTRIM
Pick a POLYLINE, LINE, CIRCLE, ARC, ELLIPSE, IMAGE or TEXT for cutting edge...
Select objects: Select an object to define the cutting edge
Pick the side to trim on: Select a point inside or outside the object (objects are trimmed to objects cutting edge)

Usage Example:
Draw several overlapping circles with intersecting lines. Specify an internal point for location of the trim.

Select a circle to define the cutting edge:



Specify a point inside the circle:



Objects trimmed to the edge of the circle:

Express Tools Standard Toolbar:

Express menu: Modify Cookie Cutter Trim

Command line: EXTRIM

Files: extrim.lsp

inner69923
2004-10-05, 09:26 PM
O_o

i know how it works in the user side
i mean how it works in the programing side, i must make a routine to work with topography, rivers and basins, that need a hard treatment of polilines

wanna make in vba what extrim does (as part of the program), but not using the command, only using the same routines/procedures.. so need someone who to watch the code and say...what the code does is this, and this, and this... only conceptual programatical-procedure, how it identify what part of a broken line is outside or inside boundary, how identify if a vertex is inside boundary... and so on

CAB2k
2004-10-10, 01:51 PM
If you open the 'Express Tools Help' 'Contents' expand 'Categories' expand
'Modify' select 'EXTRIM' you will see the help as Will displayed. But look
at the very bottom of the help page and you will see 'Files: extrim.lsp'
A file search will usually point you to the 'express' directory. Looking at
the code, you will likely have to modify the main routine to be a function
by removing the c: and you will have to make sure the support routines are
loaded. Or you could go through and recreate the sub functions need to
create a stand alone version.

CAB2k
2004-10-10, 01:55 PM
Ooops, did i misread your post? You have already looked at the routine and want
someone to comment the code?
I think even posting the code here would be a copyright infringement.

inner69923
2004-10-10, 04:08 PM
in europe still doesnt exits the soft-idea-copyright, ie, you cant copy the code but can copy the idea, in this case to VBA

CAB2k
2004-10-10, 05:01 PM
I started but ran out Of time for today.
Start at the top of the extrim.lsp ( acad2000)
lines in file is 616 if we have the same version.
Insert the following comments at the line number.
Start with line 35.
If that is any help I'll get back to it next week.


;;35-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;;36- call error handler to save & set these system variables
;;56-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;;58-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;;59- call Single pick routine & only accept these object types
;;60- returns the entity name
;;90-^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;;90-vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;;92- call error handler to save & set these system variables
;;105- only if one of the object types above
;;106- draw a pline around object
;;115- closed pline if 1st & last point are equal
;;120- get the name of the pline created
;;125- else no need for a separate trim object
;;134- if p1 go trim the object na
;;136- if separate trim object created
;;139- see if current layer is locked
;;152- restore the vars set at the start of this routine
;;170- if object matches any one of the following
;;171- set flag if pline
;;184- if pline & open clear flag
;;190- set point p1 to current UCS & get VP name
;;196- setup & zoom to object extents
;;219- get a point list from object,
;;220- ??eliminate points close together, within 1/2 of screen pixel distance

inner69923
2004-10-10, 07:49 PM
very appreciated your help, ill wait cos
the routine seems to be difficult
thanks

windowsxp5
2004-10-25, 09:33 AM
here i am attaching an image. this is a sewer manhole layout(sample only)
some times in my office receive drawings from outsides. to make that drawing asper standard i have to trim the lines from manhole circles(please look at image). that drawing may contains 1000's of manholes. is there any way to use extim in one go?

thankz in Advanz.

CAB2k
2004-10-25, 11:37 AM
You can create a modified version of extrim or simply use the trim command.
The trick is usually identifying the manholes.
Are they the only circles on a particular layer? If so then a simple ssget will do.
(setq mh_circles (ssget "_X" '((0 . "CIRCLE") (8 . "Manhole Layer"))))
Now step through each circle in the selection set.
Zoom to Circle
Offset to inside circle. (vlax-invoke vobj 'offset (- dist))
Trim circle with new circle as a fence
next circle in ss

If they are not circles, blocks for example, your task is slightly more complicated
but still doable.

So please tell us how you identify these manholes.

CAB2k
2004-10-25, 11:51 AM
Here is an example of a Circle Trim Routine:

;; Regards, Lincoln 1999

(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent
ctrim_err x f_pts svd_os svd_cmd svd_err)

(defun ctrim_err (s)
(if(/= s "Function cancelled")
(princ(strcat "\n\n" s)) )
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
)

(defun circ_pts (enm)
(setq lst (entget enm)
ang (* pi 2)
inc (/ ang 64)
tmp '()
seg 65
)
(repeat seg
(setq pt (polar(cdr(assoc 10 lst))ang
(-(cdr(assoc 40 lst))0.01))
ang (+ inc ang)
)
(setq tmp(cons pt tmp))
)
tmp
)


(setq ent (car(entsel "\nSelect circle: "))
svd_err *error*
*error* ctrim_err
svd_os (getvar "osmode")
svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(if(and ent
(=(cdr(assoc 0(entget ent)))"CIRCLE")
)
(progn
(setq f_pts(circ_pts ent))
(command "trim" ent "" "f") ;run twice in case the same
(foreach x f_pts(command x)) ;object intersects circle twice
(command "" "")
(command "trim" ent "" "f")
(foreach x f_pts(command x))
(command "" "")
(if(setq x(ssget "wp" f_pts))
(command "erase" x "")
)
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
)

windowsxp5
2004-10-25, 08:25 PM
hi all
thanks ab2draft...
i didn't tried Your lisp. because now i am not at work.
The manholes are in one layer that called "MH" and it is a circle only not a block.

CAB2k
2004-10-25, 11:19 PM
Ok, this routine runs slow but it seems to work.



(defun c:ctrim (/ circ_pts x ent ctrim_err f_pts useros usercmd cnt)

;; error function & Routine Exit
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; endif
;;reset all variables here
(setvar "osmode" useros)
(setvar "CMDECHO" usercmd)
) ;end error function

(defun spin ()
(setq a_s (if a_s a_s 4))
(princ (strcat "\r" (cadr (member (rem (setq a_s (1+ a_s)) 4)
'(0 "|" 1 "/" 2 "-" 3 "\\")))))
)

(defun circ_pts (ent / lst ang inc tmp cen rad)
(setq lst (entget ent)
ang 0.0
inc (/ (* pi 2) 64) ; 64 points
tmp '()
cen (cdr (assoc 10 lst)) ; center of circle
rad (- (cdr (assoc 40 lst)) 0.01) ; trim radius
)
(repeat 65
(setq pt (polar cen ang rad)
ang (+ inc ang)
)
(setq tmp (cons pt tmp))
)
tmp
)

(setq useros (getvar "osmode")
usercmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(if (setq ss (ssget "_X" '((0 . "CIRCLE") (8 . "MH"))))
(progn
(command "._undo" "_begin")
(command "._zoom" "_extents")
(setq cnt (sslength ss))
(prompt
(strcat "\n *-* Processing " (itoa cnt) " manholes, please wait...")
)
(repeat cnt
(setq ent (ssname ss 0))
(ssdel ent ss)
(setq f_pts (circ_pts ent)) ; get points to rim with
;; trim twice in case the same object intersects circle twice
;; like a spline or pline
(command "trim" ent "" "f")
(apply 'command f_pts)
(command "" "")
(command "trim" ent "" "f")
(apply 'command f_pts)
(command "" "")
;; erase anything within the circle
(if (setq x (ssget "wp" f_pts))
(command "erase" x "")
)
(spin)
) ; repeat
(command "._zoom" "_p")
(command "._undo" "_end")
) ; progn
) ; endif
(*error* "")
(princ)
)

windowsxp5
2004-10-26, 08:56 AM
IT WORKS...AND this routine will save my hours too...
thanks once again...