可以这样写吗：
（条件（（路径1）
（（路径2）
（以上代码都在这里）
（t（否则警报“请勿浏览”））
???
cad说：
错误的函数：“K:\\CAD\\Block\\arrow”
我不知道为什么。。。
这是我试过的代码。。。
(defun describe ()
;;;Do the mapcar function for each layer in the drawing.
(vlax-for layer
(vla-get-layers
(vla-get-activedocument
(vlax-get-acad-object)
)
)
;;;if the current layer being checked matches a predetermined name, add the needed description.
(mapcar
(function
(lambda (layname description)
(if (= (strcase (vla-get-name layer)) (strcase layname))
(vla-put-description layer description)
()
)
)
)
'("A-------O2-" ) ; This is your list of layers needing a description.
'("arrow"); This is the descriptions for each layer.Make sure the order is EXACTLY the same as in the layer list.
)
)
(princ); Silent exit.
)
(defun layercreation ()
(if(tblsearch "LAYER" "A-------O2-")
(command "_layer" "s" "A-------O2-" "")
(command "-layer" "M" "A-------O2-" "C" "red" "A-------O2-" "")
) ; end if
);en defun
(defun c:test ( / sl oldlay)
(setq path (strcat "K:\\CAD\\Block\\arrow"))
(cond
((path)
(
(setq oldlay (getvar "clayer"))
(setq sl nil)
(setq sl (dos_dwgpreview "Välj Block" "K:\\CAD\\Block\\arrow"))
(prompt "\nChoose insertion point...")
(if sl
(progn
(layercreation)
(describe)
(setvar "clayer" "A-------O2-")
(command "-insert" sl pause "1" "1" "0")
(setvar "clayer" oldlay)
);progn
);if
))(t (exit)))
) au-s公司
也许这样会有所帮助
;author : jammie
;version : 0.0
;date : 2009-02-12
;posted: cadtutor.net
;thread : http://www.cadtutor.net/forum/newreply.php?do=newreply&noquote=1&p=212231
(defun c:test (/ laycode lay_name fname oldlay path test)
;laycodes is a list of a drawing paths and layer names. Each list within laycodes is a pair(<path> <layer name>)
;The first element is the block path. The second element is the layer name associated with the block
;Any blocks found to come from a particular path will be inserted on a preset layer
;
;eg
;("K:\\CAD\\Block\\arrow" "A-------O2-")
;A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-"
;
;Note the path is case sensitive
(setq laycodes '(
("K:\\CAD\\Block\\arrow" "A-------O2-");<-edit this list as required
("K:\\CAD\\Block\\cars" "A-------O1-")
)
)
(if
;select the drawing to insert
(and (setq fname (dos_dwgpreview"Välj Block" "K:\\CAD\\Block\\"".dwg")) (/= fname ""))
;if a file has been selected
(progn
;store the current layer
(setq oldlay (getvar "clayer"))
;retrieve the path
(setq path (vl-filename-directory fname))
(if
;check the path against the laycodes
(setq test (assoc path laycodes))
;if a match is found
(or
;test if the preset layer exists
(tblsearch "layer" (setq lay_name (cadr test)))
;if it does not add it
(command "layer" "m" lay_name ""))
;if the file does not match the predefined
(alert
(strcat "\n<" (vl-filename-base fname) "> is not from a preset directory"
" \nValid directories are :"
(apply 'strcat (mapcar '(lambda (x) (strcat "\n\t" (car x))) laycodes))
"\nBlock <" (vl-filename-base fname) "> will be inserted on layer <" (getvar "clayer")">")))
(and lay_name (setvar "clayer" lay_name))
(command "-insert" fname pause "1" "1" "0")
(and lay_name(setvar "clayer" oldlay))
)
(alert "\nNo file selected")
)
(princ)
)
并添加了修改的layercreation行：
(defun c:test (/ laycode lay_name fname oldlay path test)
;laycodes is a list of a drawing paths, layer names and preset colors.
;Each list within laycodes contains 3 elements(<path> <layer name> <layer color>)
;The first element is the block path.
;The second element is the layer name associated with the block
;The third item in a list references the layer color
;Any blocks found to come from a particular path will be inserted on a preset layer
;If the layer does not exist it will be created and a layer color assigned to ir
;
;eg
;("K:\\CAD\\Block\\arrow" "A-------O2-" 1)
;A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-" which has a color 1
;
;Note the path is case sensitive
(setq laycodes '(
("K:\\CAD\\Block\\arrow" "A-------O2-"1);<-edit this list as required
("K:\\CAD\\Block\\cars" "A-------O1-"140)
)
)
(if
;select the drawing to insert
(and (setq fname (dos_dwgpreview"Välj Block" "K:\\CAD\\Block\\"".dwg")) (/= fname ""))
;if a file has been selected
(progn
;store the current layer
(setq oldlay (getvar "clayer"))
;retrieve the path
(setq path (vl-filename-directory fname))
(if
;check the path against the laycodes
(setq test (assoc path laycodes))
;if a match is found
(or
;test if the preset layer exists
(tblsearch "layer" (setq lay_name (cadr test)))
;if it does not add it
(and
(command "layer" "m" lay_name "")
(command "layer" "c" (caddr test) lay_name "" "" );<-line added to change the layer to the required color
)
)
;if the file does not match the predefined
(alert
(strcat "\n<" (vl-filename-base fname) "> is not from a preset directory"
" \nValid directories are :"
(apply 'strcat (mapcar '(lambda (x) (strcat "\n\t" (car x))) laycodes))
"\nBlock <" (vl-filename-base fname) "> will be inserted on layer <" (getvar "clayer")">")))
(and lay_name (setvar "clayer" lay_name))
(command "-insert" fname pause "1" "1" "0")
(and lay_name(setvar "clayer" oldlay))
)
(alert "\nNo file selected")
)
(princ)
) Your welcome,
I was actually a little intrigued by DOSLIB as I had never heard of it before!
Try the revised version of the code, it only needed a small change.
Just add the preset layer color after layer name in each element of the layercodes
(defun c:test (/ laycode lay_name fname oldlay path test);laycodes is a list of a drawing paths, layer names and preset colors.;Each list within laycodes contains 3 elements();The first element is the block path.;The second element is the layer name associated with the block;The third item in a list references the layer color ;Any blocks found to come from a particular path will be inserted on a preset layer;If the layer does not exist it will be created and a layer color assigned to ir;;eg;("K:\\CAD\\Block\\arrow" "A-------O2-" 1);A block inserted from "K:\\CAD\\Block\\arrow" will be inserted on layer "A-------O2-" which has a color 1;;Note the path is case sensitive (setq laycodes '( ("K:\\CAD\\Block\\arrow" "A-------O2-"1); Yes ...
I was looking into tool palletes.
problem is .. that in this office all architects or 90% of them use 19 inch screens.
With couple of toolpalletes it really require some screen.space.
besides I do not know how they work from a network server.
I tried once and I had bad experiance.
But maybe I did not try enough
Thanx Sir! Hmm...
It inserts still in color(white) I have my palettes set to AutoHide. That way they only take up a thin strip on the side of the screen.
The palette is just a place holder for the block not a container. You can drag a block from a drawing onto the palette. Then when you drag a block from that palette AutoCAD goes and gets the block definition from the drawing you used to create the block. That is why I have a few drawings in our symbols folder that contain the blocks I want. If I need to update a block it can be done in one drawing that is under my control, not a project specific GA that somebody else could modify. Also my drawing will not get renamed or moved - a real problem to palettes if the source file ceases to exist. ah its working now ...
I deleted this :
(command "layer" "c" (caddr test) lay_name "" )
and added modified the layercreation line:
(command "layer" "m" lay_name "c" (caddr test) lay_name "")
页:
1
[2]