home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 15
/
BUGCD1998_06.ISO
/
aplic
/
felixcad
/
fcaddata.z
/
FLX_PCOP.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1996-09-30
|
2KB
|
77 lines
;;; FLX_PCOP.LSP
;;; ==========================================================
;;; (C)opyright Felix Computer Aided Technologies GmbH 1995-96
;;; ==========================================================
;;; Created: Jan 20, 1996 / vp
;;; Changed: Sep 29, 1996 / vp
;;; ==========================================================
;;; This function "copies" the properties layer, linetype
;;; and color of a selected entity to the objects selected
;;; by the user when prompted to select objects...
;;; ==========================================================
(defun FLX_COPYPROP( / prt_list e1 e2 el1 el2 ep1 s1 s2 s3)
;;; Error Handler
(FLX_FUNC_INIT)
;;; Prompt List
(setq prt_list '(
"Select entity for reference properties: "
"Select objects to modify...\n"
))
(if FLX_XLANGUAGE (FLX_XLANGUAGE "_pcop" nil))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(if (entlast) (progn
;;;@Select entity for reference properties:
(setq ep1 (entsel (nth 0 prt_list)))
(if ep1 (progn
(setq el1 (entget (setq e1 (car ep1))))
(setq s1 (assoc 62 el1) s2 (assoc 6 el1))
(setq s3 (assoc 8 el1))
;;;@Select objects to modify:
(princ (nth 1 prt_list))
(setq ss1 (ssget))
(if ss1
(progn
(setq i1 (sslength ss1))
(while (> i1 0)
(setq i1 (1- i1))
(setq el2 (entget (setq e2 (ssname ss1 i1))))
(if s1 ;;; COLOR
(if (assoc 62 el2)
(setq el2 (subst s1 (assoc 62 el2) el2))
(setq el2 (append el2 (list s1)))
)
(setq el2 (append el2 (list (cons 62 256))))
)
(if s2 ;;; LINETYPE
(if (assoc 6 el2)
(setq el2 (subst s2 (assoc 6 el2) el2))
(setq el2 (append el2 (list s2)))
)
(setq el2 (append el2 (list (cons 6 "BYLAYER"))))
)
(if s3 ;;; LAYER
(setq el2 (subst s3 (assoc 8 el2) el2))
)
(entmod el2)
(if (or (= (cdr (assoc 0 el2)) "INSERT")
(= (cdr (assoc 0 el2)) "POLYLINE")
)
(entupd e2)
)
)
)
)
)) ;;; if ep1
)) ;;; if entlast
(FLX_FUNC_EXIT)
(princ)
)
(princ)