TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: ronjonp on August 24, 2004, 01:29:03 PM
-
It allows you to select a block to define layer to trim around. Then it cycles through all the blocks on that layer and trims polyline that cross through them. Can it be edited so it will run faster?
;;;----------------------------------------------------------
;;;| SYMT |
;;;| Trim polylines so that they will not cross symbols. |
;;;| A union between a set of layers and a set of symbols |
;;;| will be trimed. |
;;;| |
;;;----------------------------------------------------------
(defun C:SYMT (
/
S ; selection set of entities
LS ; selection set of layer entities
en ; specific entity from selection set
ed ; data associated with specific entity
len ; specific layer entity from selection set
led ; data associated with specific layer entity
count ; selection set counter
lcount ; layer selection set counter
)
(setvar "CMDECHO" 0) ;0 to hide command echos
(pusherr (list (list setq 'S nil 'LS nil)))
(pushvar '("SNAPMODE" "OSMODE"))
(setvar "OSMODE" 0) ;Clear object snap mode
(setvar "SNAPMODE" 0)
(setq
S (ssadd)
LS (ssadd)
count 0
)
(lfeed 3)
(prompt "\nIdentify the layer(s) containing symbols to trim around:")
(setq LS (ssget)) ; Get entities marked by user
(lfeed 3)
(prompt "\nSelect set containing symbols to be trimed around:")
(setq S (ssget)) ; Get entities marked by user
(lfeed 3)
(if S (progn ; if set exists
(repeat (sslength S) ; traverse selection set
(setq
en (ssname S count)
ed (entget en)
count (1+ count)
lcount 0
)
(if (= "INSERT" (dxf 0 ed))(progn ; if insertion block
(repeat (sslength LS)
(setq
len (ssname LS lcount)
led (entget len)
lcount (1+ lcount)
)
(if (= (dxf 8 ed) (dxf 8 led)) (symtr ed))
); end repeat
));end if
); end while
));end if
(princ)
);defun
;;;*
(if debug (princ "c:symt loaded\n"))
(C:SYMT)
;;;----------------------------------------------------------
;;;| SYMTR |
;;;| Trim the polylines crossing the specified symbol. |
;;;| |
;;;----------------------------------------------------------
(defun symtr (
spnt ; entity data associated with trim symbol
/
S ; selection set of entities
en ; specific entity from selection set
ed ; data associated with specific entity
count ; selection set counter
cutent ; entity used as cutting edge in trim
r ; radius of symbol
pt1 ; insertion point of symbol
)
(pusherr (list (list setq 'S nil)))
(setq
pt1 (dxf 10 spnt)
r (/ (abs (dxf 41 spnt)) 2)
)
(command "_.CIRCLE" pt1 r)
(setq
cutent (entlast)
S (ssget "_F" (cltolist cutent 20))
count 0
)
(if S (progn ; if set exists
(command "_.TRIM" cutent "")
(repeat (sslength S) ; traverse selection set
(setq
en (ssname S count)
ed (entget en)
count (1+ count)
)
(if (/= "INSERT" (dxf 0 ed)) ; if not insertion block
(command (list en pt1))
)
); end while
(command "")
));end if
(command "_.ERASE" cutent "")
(princ)
);defun
;;;*
(if debug (princ "symtr loaded\n"))
;;;----------------------------------------------------------
;;;| PUSHERR |
;;;| Push a sublist of error expressions onto the #error |
;;;| list. |
;;;| |
;;;----------------------------------------------------------
(defun pusherr (
sublst ; sublist to be pushed onto the list
)
; #error ; list of commands to execute on error
(setq #error (append sublst #error)) ;add sublst to the list
(princ)
);defun
;;;*
(if debug (princ "pusherr loaded\n"))
;;;----------------------------------------------------------
;;;| PUSHVAR |
;;;| Push system variables onto the #error list. |
;;;| |
;;;----------------------------------------------------------
(defun pushvar (
varlst ; list of variables to be added to #error list
)
; #error ; list of commands to execute on error
(repeat (length varlst) ;for all vars in varlst
(setq
#error (append (list (list setvar (car varlst) (getvar (car varlst)))) #error)
varlst (cdr varlst)
)
)
(princ)
);defun
;;;*
(if debug (princ "pushvar loaded\n"))
;;;----------------------------------------------------------
;;;| LFEED |
;;;| Prints the number of line feeds passed to it. |
;;;| |
;;;----------------------------------------------------------
(defun lfeed (
count ; number of line feeds to print
)
(repeat (1- count) (princ "\n "))
(princ "\n")
(princ)
); defun
;;;*
(if debug (princ "lfeed loaded\n"))
;;;----------------------------------------------------------
;;;| DXF |
;;;| Takes an integer dxf code and an entity or entity data |
;;;| list and returns the data element of the association |
;;;| pair. |
;;;| |
;;;----------------------------------------------------------
(defun dxf (
code ; DXF code
ed ; Entity name or data list
)
; Turn entity name into entity data
(if (and (not (listp ed)) ed) (setq ed (entget ed)))
(cdr (assoc code ed)) ; Find association pair & strip 1st element
); defun
;;;*
(if debug (princ "dxf loaded\n"))
;;;----------------------------------------------------------
;;; CLTOLIST |
;;; This function will convert a circle to a list of |
;;; points. The circle is subdivided into the specified |
;;; number of segments. |
;;; |
;;;----------------------------------------------------------
(defun cltolist (
en ; Entity name to convert
segs ; Number of segments
/
ed ; Current entity data
plist ; Point list to be returned
rad ; Radius of arc
cp ; Center point of arc
ang1 ; Initial angle
angs ; Angle between subsegments in arc
count ; Counter of arc subsegments
)
(if (= (dxf 0 en) "CIRCLE") (progn
; Traverse the pline
(setq
ed (entget en)
plist nil
; Define the circle
cp (dxf 10 ed)
rad (dxf 40 ed)
ang1 0
; Prepare to traverse the arc
angs (/ (* PI 2) segs)
count 0
)
; Traverse the arc & save points
(while (< count segs)
(setq
plist (append plist (list (polar cp (+ ang1 (* count angs)) rad)))
count (1+ count)
)
);end while
; Close the polyline
(setq plist (append plist (list (car plist))))
));end if
; Return the point list
(if plist plist nil)
);defun
;;;*
(if debug (princ "cltolist loaded\n"))
-
I dont understand? Consolidated into what?
-
Bad choice of words on my part.....was wondering if the routine could be made faster.
-
It looks pretty clean up until you see all the command code that could be changed to something like entmake, but I don't think anything will really make it much faster. Milliseconds maybe, unless you're talking hundreds of object insertions. You do recall the code races we had in the early days of the swamp, I presume. Search them out. They're in vlisp hackers. Mark, Stig and myself were quite involved in testing different functions with the help of others.
-
Oh, I get cha.
...I Duno. We would have to break the app down piece by piece and "evaluate" each process. (Basicly, speed of code is a concern that should be addressed right away.)