TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Adesu on November 17, 2006, 01:15:32 AM

Title: Color object with bylayer and non bylayer
Post by: Adesu on November 17, 2006, 01:15:32 AM

Hi Alls,
Now you should create an object,depend on you,a circle/rectangular or ellipse.That object set color with bylayer,and then test with my code,here that code.
My code can not change or modification color of object,any one know what wrong in that code,thanks for your help.

Code: [Select]

;(defun opts (sse col vevo xcol tcol /)
;  (setq opt
; (getreal
;    (strcat "\nEnter new color < "
;    (itoa tcol)
;    " > : ")))
;  (if (= opt nil)(setq opt tcol))
;  )
;(defun modi ()
;  (setq new_col (cons 62 (fix opt)))
;  (setq old_col (cons 62 col))
;  (setq ed (subst new_col old_col sse))
;  (entmod ed)
;  )

(defun c:test (/ col ed new_col old_col opt ss sse tcol vevo xcol)
  (if
    (setq ss (car (entsel "\nSelect a object")))
    (progn
      (setq sse (entget ss))
      (setq col (cdr (assoc 62 sse)))
      (if
(= col nil)
(progn
  (setq vevo (vlax-ename->vla-object ss))
  ;(vlax-dump-object vevo)
  (setq xcol (vlax-get vevo 'TrueColor))
  ;(vlax-dump-object xcol)
  (setq tcol (vlax-get xcol 'ColorIndex))
  ;(opts)
  (setq opt
(getreal
   (strcat "\nEnter new color < "
   (itoa tcol)
   " > : ")))
  (if (= opt nil)(setq opt tcol))
  (vlax-put vevo 'ColorIndex (itoa (fix opt))) ; >>still problem !!!
  )                                            ; progn
(progn
  ;(opts)
  ;(modi)
  (setq opt
(getreal
   (strcat "\nEnter new color < "
   (itoa col)
   " > : ")))
  (if (= opt nil)(setq opt col))
  (setq new_col (cons 62 (fix opt)))
  (setq old_col (cons 62 col))
  (setq ed (subst new_col old_col sse))
  (entmod ed)
  )                                       ; progn
)                                         ; if
      )                                           ; progn
    (alert "\nInvalid selected object,please try again")
    )                                         ; if
  (princ)
  )


Title: Re: Color object with bylayer and non bylayer
Post by: ElpanovEvgeniy on November 17, 2006, 02:02:43 AM

Code: [Select]

(defun c:test (/ col ed new_col old_col opt ss sse tcol vevo xcol)
  (if
    (setq ss (car (entsel "\nSelect a object")))
     (progn
       (setq sse (entget ss))
       (setq col (cdr (assoc 62 sse)))
       (if
         (= col nil)
          (progn
            (setq vevo (vlax-ename->vla-object ss))
  ;(vlax-dump-object vevo)
            (setq xcol (vlax-get vevo 'TrueColor))
  ;(vlax-dump-object xcol)
            (setq tcol (vlax-get xcol 'ColorIndex))
  ;(opts)
            (setq opt
                   (getreal
                     (strcat "\nEnter new color < "
                             (itoa tcol)
                             " > : "
                     ) ;_  strcat
                   ) ;_  getreal
            ) ;_  setq
            (if (= opt nil)
              (setq opt tcol)
            ) ;_  if
            (vla-put-Color vevo  (fix opt))
          ) ; progn
          (progn
  ;(opts)
  ;(modi)
            (setq opt
                   (getreal
                     (strcat "\nEnter new color < "
                             (itoa col)
                             " > : "
                     ) ;_  strcat
                   ) ;_  getreal
            ) ;_  setq
            (if (= opt nil)
              (setq opt col)
            ) ;_  if
            (setq new_col (cons 62 (fix opt)))
            (setq old_col (cons 62 col))
            (setq ed (subst new_col old_col sse))
            (entmod ed)
          ) ; progn
       ) ; if
     ) ; progn
     (alert "\nInvalid selected object,please try again")
  ) ; if
  (princ)
)

Title: Re: Color object with bylayer and non bylayer
Post by: Adesu on November 17, 2006, 02:09:06 AM

Ah... it's easy solution :pissed:
Thanks Elpanov.

Title: Re: Color object with bylayer and non bylayer
Post by: ElpanovEvgeniy on November 17, 2006, 02:15:21 AM

Quote from: Adesu on November 17, 2006, 02:09:06 AM

Ah... it's easy solution :pissed:
Thanks Elpanov.

 :-)

Code: [Select]

(defun c:test (/ e i)
  (if (setq e (car (entsel "\nSelect a object")))
    (if (setq i (assoc 62 (entget e)))
      (entmod
        (subst
          (cons 62 (ACAD_COLORDLG (cdr i)))
          i
          (entget e)
        ) ;_  subst
      ) ;_  entmod
      (entmod
        (append
          (reverse
            (vl-member-if
              (function
                (lambda (x)
                  (= (car x) 8)
                ) ;_  lambda
              ) ;_  function
              (reverse (entget e))
            ) ;_  vl-member-if
          ) ;_  reverse
          (cons
            (cons 62 (ACAD_COLORDLG 256))
            (cdr
              (vl-member-if
                (function
                  (lambda (x)
                    (= (car x) 8)
                  ) ;_  lambda
                ) ;_  function
                (entget e)
              ) ;_  vl-member-if
            ) ;_  cdr
          ) ;_  cons
        ) ;_  append
      ) ;_  entmod
    ) ;_  if
    (alert "\nInvalid selected object,please try again")
  ) ;_  if
)

Title: Re: Color object with bylayer and non bylayer
Post by: ElpanovEvgeniy on November 17, 2006, 02:20:23 AM

If use VLA-

Code: [Select]

(defun c:test (/ e)
  (if (setq e (car (entsel "\nSelect a object")))
    (vla-put-Color (vlax-ename->vla-object e)  (ACAD_COLORDLG 256))
    (alert "\nInvalid selected object,please try again")
  ) ;_  if
)

Title: Re: Color object with bylayer and non bylayer
Post by: Adesu on November 17, 2006, 02:29:38 AM

Wow...more alternative choose,many thanks.

Title: Re: Color object with bylayer and non bylayer
Post by: Kerry on November 17, 2006, 03:49:04 AM

(vla-put-Color .....

... Yes !