• This forum is the machine-generated translation of www.cad3d.it/forum1 - the Italian design community. Several terms are not translated correctly.

listed accommodation for multiple selection

  • Thread starter Thread starter jim78b
  • Start date Start date

jim78b

Guest
I have this list to change the color to the nested blocks I would need to make that you can select more than one object thanks and perfavore. . .


(defun c:blcc () (pl:block-color) (princ)

(defun c:encc () (pl:block-ent-color) (princ)

;;get from alaspher http://forum.dwg.ru/showthread.php?t=1036

;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18

(vl-load-com)

(defun pl:block-ent-color (/ adoc blocks color ent lays)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

lays (vla-get-layers adoc)

color (acad_colordlg 256)

)

(if color

(progn (setvar "errno" 0)

(vla-startundomark adoc)

(while (and (not (vl-catch-all-error-p

(setq ent (vl-catch-all-apply

(function nentsel)

'("\nselect entity <exit>:")

)

)

)

)

(/= 52 (getvar "errno"))

)

(if ent

(progn (setq ent (vlax-ename->vla-object (car ent))

lay (vla-item lays (vla-get-layer ent))

)

(if (= (vla-get-lock lay) :vlax-true)

(progn (setq layloc (cons lay layloc))

(vla-put-lock lay :vlax-false)

)

)

(vl-catch-all-apply (function vla-put-color) (list ent color))

(vla-regen adoc acallviewports)

)

(princ "\nnothing selection! try again.")

)

)

(foreach i layloc (vla-put-lock i :vlax-true))

(vla-endundomark adoc)

)

)

(princ)

)

(defun pl:block-color (/ adoc blocks color ins lays)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

blocks (vla-get-blocks adoc)

lays (vla-get-layers adoc)

color (acad_colordlg 256)

)

(if color

(progn (setvar "errno" 0)

(vla-startundomark adoc)

(while (and (not (vl-catch-all-error-p

(setq ins (vl-catch-all-apply

(function entsel)

'("\nselect block <exit>:")

)

)

)

)

(/= 52 (getvar "errno"))

)

(if ins

(progn (setq ins (vlax-ename->vla-object (car ins)))

(if (= (vla-get-objectname ins) "acdbblockreference")

(if (vlax-property-available-p ins 'path)

(princ "\nthis is external reference! try pick other.")

(progn (_pl:block-color blocks ins color lays)

(vla-regen adoc acallviewports)

)

)

(princ "\nthis isn't block! try pick other.")

)

)

(princ "\nnothing selection! try again.")

)

)

(vla-endundomark adoc)

)

)

(princ)

)

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)

(vlax-for e (vla-item blocks (vla-get-name ins))

(setq lay (vla-item lays (vla-get-layer e)))

(if (= (vla-get-freeze lay) :vlax-true)

(progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false))

)

(if (= (vla-get-lock lay) :vlax-true)

(progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false))

)

(vl-catch-all-apply (function vla-put-color) (list e color))

(if (and (= (vla-get-objectname e) "acdbblockreference")

(not (vlax-property-available-p e 'path))

)

(_pl:block-color blocks e color lays)

)

(foreach i layfrz (vla-put-freeze i :vlax-true))

(foreach i layloc (vla-put-lock i :vlax-true))

)

)

(progn

(princ "\blcc - changes color of the chosen blocks")

(princ "\nencc - changes color of the chosen objects (may be element of the block)")

(princ))</exit></exit>
 
then I would also have this that rotates and copies 1 time I would need that copy endless times until I interrupt the command is possible? Thank you.

(defun c:rtc (/ crane)
(setq crane)

(if crane)
(progn)
(command "_copy" crane "" (list 0 0)(list 0 0))
(command "_rotate" "_p"")
(princ "\nbase point and first corner point: "
(command pauses)
(command (getvar "lastpoint")
(princ "\nsecond corner point: "
(command breaks)
(princ "\nangolo finale: "
(command breaks)
)
)

(princ)
)
 
(defun c: rtc (/ gru break)
(setq break nil)(while (=/ break nil)(setq crane)

(if crane)
(progn)
(command "_copy" crane "" (list 0 0)(list 0 0))
(command "_rotate" "_p"")
(princ "\nbase point and first corner point: "
(command pauses)
(command (getvar "lastpoint")
(princ "\nsecond corner point: "
(command breaks)
(princ "\nangolo finale: "
(command breaks)
)
)

(princ))
)
 
Sorry crystal doesn't work says:

command: rtc; error: no function: definition =
command:
 
Code:
(defun c:rtc (/ crane break)

(setq break t)
(while)

(prompt "\nselect entity: "
(setq crane)

(if crane)
(progn)
(command "_copy" crane "" (list 0 0)(list 0 0))
(command "_rotate" "_p"")
(princ "\nbase point and first corner point: "
(command pauses)
(command (getvar "lastpoint")
(princ "\nsecond corner point: "
(command breaks)
(princ "\nangolo finale: "
(command breaks)
)
)

(princ)
)
)

(setq break t)
 
thanks now I try:).riesci x favor to arrange the other list x to select more objects?te am grateful
 
I tried rtc.lsp but it is not as I say, I would like to do as the copy command, which repeats the objects until I interrupt the command.
 

Forum statistics

Threads
44,997
Messages
339,767
Members
4
Latest member
ibt

Members online

No members online now.
Back
Top