TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mark on October 02, 2003, 09:12:00 AM
-
originally posted in this http://theswamp.org/phpBB2/viewtopic.php?t=35 thread.
the contestants
Daron
;;; "User Friendly Layer Setup"
;;; layersetup1.lsp
;;; By: Jon Nelson
;;; DFTG1352
;;; Thomas Longnecker
;;; Altered and commented by someone else
;;; Ripped apart for altered use by another
(defun c:layersetup ()
(vl-load-com)
(setq num 1
name "DIM"
reset (getvar 'clayer)
cnt 1)
(initget 7) ;I initially put 6. Edited to make it better.
(setq rept (getint "\nHow many layers do you want?: "))
(repeat rept
(if (> cnt 9)
(setq layName (strcat name (rtos cnt 2 0)))
(setq layName (strcat name "0" (rtos cnt 2 0)))
)
(setq cnt (1+ cnt))
(if (snvalid layName)
(setq n (append (list layName) n))
(setq tn nil)
)
)
(foreach item n
(command "Layer" "m" item "c" 5 "" "")
)
(setvar 'clayer reset)
(princ)
)
(prompt "Enter LAYERSETUP to start")
SMadsen
(defun C:ADDLAYERS ()
;; put whatever color number here
(makeLayers 5)
)
(defun makeLayers (cnum / cnt ctrl layname laynum laypref zero zeroln)
(setq ctrl 0)
(initget 6)
(cond ((and (numberp cnum) (setq laynum (getint "\nNumber of layers: ")))
(initget 128 "Dim")
(setq laypref (cond ((setq laypref (getkword "\nLayer prefix <Dim>: "))
(setq laypref (strcase laypref)))
("DIM")))
(setq cnt 1
zeroln (strlen (strcat laypref (itoa laynum)))
zero ""
)
(repeat laynum
(repeat (- zeroln (strlen (strcat laypref (itoa cnt))))
(setq zero (strcat zero "0"))
)
(setq layname (strcat laypref zero (itoa cnt))
cnt (1+ cnt)
zero ""
)
(if (entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 layname)
(cons 62 cnum)
'(70 . 0)))
(setq ctrl (1+ ctrl))
)
)
)
)
(princ (strcat "\n" (itoa ctrl) " layers created"))
(princ)
)
Mark
(defun c:LayerCreator ( / lo num ll)
(vl-load-com)
(setq lo
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(initget 7)
(setq num (getint "\nHow many dim layers to create? (must be < 200) : "))
(if
(and num (< num 200))
(while
(> num 0)
(cond
((< num 10)
(setq ll (cons (strcat "DIM0"(itoa num)) ll)))
(T
(setq ll (cons (strcat "DIM"(itoa num)) ll))
)
)
(setq num (1- num))
); while
; else
(prompt (strcat "\nAre you kidding..."(itoa num)" layers...."))
); if
(if ll
(mapcar
'(lambda (x / newlayer)
(setq newlayer (vla-add lo x))
(vlax-put-property newlayer 'Color 5)
(vlax-release-object newlayer)
)
ll)
); if
(if (not (vlax-object-released-p lo))
(vlax-release-object lo)); if
(princ)
); defun
SMadsen
And the result is ... !!!!
Two tests were done. One for each command in a fresh drawing each (called 15 times) and one in the same drawing where the commands were called in this sequence (called 10 times each):
AddLayer, LayerSetup, LayerCreator
LayerSetup, LayerCreator, AddLayer
LayerCreator, AddLayer, LayerSetup
Each command set up 100 layers and was followed by garbage collection, purge and garbage collection. Timer was started as soon as user inputs were done. The code below shows were timers were started and ended in each routine along with the timer and cleanup code used.
First, the results!! Unit is in seconds
New drawings, only one command used in each drawing
LayerSetup AddLayers LayerCreator
0,515989 0,046992 0,094025
0,968975 0,061999 0,093985
1,547004 0,046992 0,092979
2,124994 0,046992 0,092979
2,735008 0,061999 0,078978
3,391009 0,063005 0,094025
4,157008 0,063005 0,094025
5,640001 0,063005 0,092978
6,531005 0,047033 0,109997
7,344036 0,061999 0,092978
8,296998 0,063005 0,094025
9,218015 0,061999 0,109032
10,436998 0,063005 0,108992
11,264996 0,063005 0,093019
12,202991 0,063005 0,108992
Averages:
5,758335 0,058469 0,096734
Same drawing, called in sequence as mentioned
LayerSetup AddLayers LayerCreator
0,484005 0,045986 0,092979
1,078070 0,046992 0,078012
1,922017 0,045986 0,078012
2,688016 0,063005 0,109997
3,592980 0,077972 0,108992
4,922001 0,061999 0,108992
6,077980 0,078012 0,108992
7,280990 0,078978 0,108992
9,188001 0,078012 0,108992
10,671034 0,078012 0,108992
Averages:
4,790509 0,065495 0,101295
SMadsen
Notice anything in particular with the command pipeline in each test?
Here's the code:
(defun startTimer ()
(setq time (getvar "DATE"))
)
(defun endTimer (func)
(setq time (- (getvar "DATE") time)
seconds (* 86400.0 (- time (fix time)))
)
(gc)
(outPut seconds func)
)
(defun outPut (secs def)
(princ "\nPurging...")
(command "PURGE" "Layers" "*" "N")
(gc)
(princ (strcat "\nTimed " def ": " (rtos secs 2 6)))
(princ)
)
(defun C:ADDLAYERS ()
;; put whatever color number here
(makeLayers 5)
)
(defun makeLayers (cnum / cnt ctrl layname laynum laypref zero zeroln)
(setq ctrl 0)
(initget 6)
(cond ((and (numberp cnum) (setq laynum (getint "\nNumber of layers: ")))
(initget 128 "Dim")
(setq laypref (cond ((setq laypref (getkword "\nLayer prefix <Dim>: "))
(setq laypref (strcase laypref)))
("DIM")))
(startTimer)
(setq cnt 1
zeroln (strlen (strcat laypref (itoa laynum)))
zero "")
(repeat laynum
(repeat (- zeroln (strlen (strcat laypref (itoa cnt))))
(setq zero (strcat zero "0")))
(setq layname (strcat laypref zero (itoa cnt))
cnt (1+ cnt)
zero "")
(if (entmake (list '(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 layname)
(cons 62 cnum)
'(70 . 0)))
(setq ctrl (1+ ctrl))))))
(princ (strcat "\n" (itoa ctrl) " layers created"))
(princ)
(endTimer (vl-symbol-name 'makeLayers))
)
(defun c:layersetup ()
(vl-load-com)
(setq num 1 name "DIM" reset (getvar 'clayer) cnt 1)
(initget 7) ;I initially put 6. Edited to make it better.
(setq rept (getint "\nHow many layers do you want?: "))
(startTimer)
(repeat rept
(if (> cnt 9)
(setq layName (strcat name (rtos cnt 2 0)))
(setq layName (strcat name "0" (rtos cnt 2 0))))
(setq cnt (1+ cnt))
(if (snvalid layName)
(setq n (append (list layName) n))
(setq tn nil)))
(foreach item n
(command "Layer" "m" item "c" 5 "" ""))
(setvar 'clayer reset)
(princ)
(endTimer (vl-symbol-name 'c:layersetup))
)
(defun c:LayerCreator (/ lo num ll)
(vl-load-com)
(setq lo (vla-get-layers (vla-get-activedocument
(vlax-get-acad-object))))
(initget 7)
(setq num (getint "\nHow many dim layers to create? (must be < 200) : "))
(startTimer)
(if (and num (< num 200))
(while (> num 0)
(cond ((< num 10)
(setq ll (cons (strcat "DIM0" (itoa num)) ll)))
(T (setq ll (cons (strcat "DIM" (itoa num)) ll))))
(setq num (1- num))) ; while
(prompt (strcat "\nAre you kidding..." (itoa num) " layers....")))
(if ll (mapcar
'(lambda (x / newlayer)
(setq newlayer (vla-add lo x))
(vlax-put-property newlayer 'Color 5)
(vlax-release-object newlayer)) ll))
(if (not (vlax-object-released-p lo))
(vlax-release-object lo))
(princ)
(endTimer (vl-symbol-name 'c:LayerCreator))
)
Mark
Very interesting Stig, I am truly enjoying this.
I also tried creating 1000 layers with each.
1000 LAYERS
Timed MAKELAYERS: 0.172037 Stig's
Timed C:LAYERCREATOR: 0.297001 Mark's
Timed C:LAYERSETUP: 4.264994 Daron's
I'm going back to the pits for a tune up. <g>
SMadsen
Will be interesting to see if you can tune activex to match lisp in
performance.
Just for the fun of it, I tried creating 12450 layers. AddLayers took 16
seconds, LayerSet took 10 minutes - not to create the layers, though, but to
fold with a fatal error! Never got around to test LayerCreator after that
Mark
12450 layers.......
C:LAYERCREATOR: 15.125003
SMadsen
Yeah yeah, AFTER you changed to ENTMAKE I'm sure! heh
Seriously, would you mind run AddLayers on your machine with 12450 layers? I
hate to admit it, but this is an OLD 500 MHz (don't laugh .. ok, laugh .. I
do!) PIII thingy.
-
Yeah yeah, AFTER you changed to ENTMAKE I'm sure! heh
Nope :D
12450 layers created
Purging...
Timed MAKELAYERS: 4.547028
that thing is fast!!
-
Oh, goodie! Thought ENTMAKE would outperform ActiveX :)
Thanks for testing it.
-
Ok, now compile it and see what happens. This is intreristing.
-
Se7en, can you elaborate? I get the same readouts from .vlx as from .lsp
-
:shock: Really?! ok, that goes against what i thought. I thought that a VLX would be faster. ...well actualy, Randall told me that a VLX is nothing more then Char. substution anyways so i guess that makes sence.
This brings up a Q for me. If i have a binary file, why cant i run a binary file in autocad? (I supose you would have to build an interperter for it cause i dont think there is one)
:? *thinking about so much stuff*
-
Oh, I thought you had tried compiled it and I had overlooked something. I'm not well versed in compiled lisps so it wouldn't have been hard for me to miss anything in that regard.
What do you mean with a binary file?
-
After compiling to .vlx
MAKEFILE
(PRV-DEF (:target . "drag_race.VLX")
(:active-x . T)
(:separate-namespace . T)
(:protected . T)
(:load-file-list (:lsp "DRAGRACE.LSP"))
(:require-file-list)
(:ob-directory)
(:tmp-directory)
(:optimization . lsa)
)
12450 layers made with each
Timed MAKELAYERS: 4.140995
Timed C:LAYERCREATOR: 13.859993
-
Oh I dont know, i was just thinking out loud, sorta. (Im just goofy today, i just got done with a big job so my mind is free to roam and think of diff stuff.)
-
Just a thought...
the timer is invoked before the repeat loops in all three examples. Yet the examples inside the repeat loops all have different ways of deriving the layer name, etc.
So would the test results change if the metohods inside the repeat loop on either side of "entmake" or other choices were made similar?
One routine uses while instead of repeat - how does that affect the time?
In a way - there are too many dissimilar items to really know how much faster "entmake" is.
-
google
Hello people
Is it difficult to change the lisp so that one can count up the layer with color.
Thank you
Hallo Leute
Ist es schwierig das Lisp so zu ändern das man auch die Layerfarbe mit hochzählen kann.
Danke
-
I think most Civil 3D users can create that number of layers by simply opening one of the default templates....without using any code at all. :lmao:
-
I think most Civil 3D users can create that number of layers by simply opening one of the default templates....without using any code at all. :lmao:
Yes, they use way too many layers, takes those of us in MEP forever to freeze off all of the stuff that we don't need on our site plans.
-
Is it difficult to change the lisp so that one can count up the layer with color.
I'm not sure that I understand, this?
(defun c:test ( / c n )
(setq c 0)
(if (setq n (getint "\nNumber of Layers: "))
(repeat n
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 (itoa n))
(cons 62 (setq c (1+ (rem c 255))))
'(70 . 0)
)
)
(setq n (1- n))
)
)
(princ)
)
-
Thank you Lee
Does not work completely.
Danke Lee
Funktioniert leider nicht ganz.
-
Hugo, maybe you want this -
color and names are now corresponding each others :
(defun c:test ( / c n k )
(setq c 0 k 0)
(initget 7)
(if (setq n (getint "\nNumber of Layers: "))
(while (< k n)
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 (itoa (setq k (1+ k))))
(cons 62 (setq c (1+ (rem c 256))))
'(70 . 0)
)
)
)
)
(princ)
)
-
Hey thanks :-) :-) :-)
Super Danke
-
Hey, Hugo, if you want to make layer names that will have prefix zeros of number of input layers, you can use this :
This way layers will be always sorted from first to last one...
(defun c:test ( / c n nl k kl pref name )
(setq c 0 k 0 pref "")
(initget 7)
(if (setq n (getint "\nNumber of Layers: ") nl (strlen (itoa n)))
(while (< k n)
(setq k (1+ k) kl (strlen (itoa k)))
(repeat (- nl kl)
(setq pref (strcat "0" pref))
)
(setq name (strcat pref (itoa k)))
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 name)
(cons 62 (setq c (1+ (rem c 256))))
'(70 . 0)
)
)
(setq pref "")
)
)
(princ)
)
M.R.
-
Super 1000 times thank you :-) :-) :-)
Super 1000 mal Danke