Hatch True Color to layer

[Dien nguyen]

I'm trying to write a lisp to create a layer with color and name from an existing hatch and text, however I can't get the true hatch color to put in the layer color, here is my lisp, showing hatch -color is just the ACI color. How to get true color for hatch-color? And can hatch pick first.

 

(defun C:HN (/ obj hatch-name hatch-color new-layer)
	(setq sset (car (entsel)))

	(setq obj (vlax-ename->vla-object sset))
	(setq hatch-color (vla-get-color obj))

	(setq ent (entsel "Pick text"))
	(setq txt (cdr (assoc 1 (entget (car ent)))))

;	(createlayer test '(100 150 200) "Continuous" aclnwtbylwdefault)	
	(createlayer txt hatch-color "Continuous" aclnwtbylwdefault)

	(command "chprop" sset "" "la" txt  "")
)

(defun createlayer ( name color linetype lineweight / lay tru )
    (setq lay (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) name))
    (if (listp color)
        (progn
            (setq tru (vla-get-truecolor lay))
            (apply 'vla-setrgb (cons tru color))
            (vla-put-truecolor lay tru)
        )
        (vla-put-color lay color)
    )
    (vla-put-linetype lay linetype)
    (vla-put-lineweight lay lineweight)
    lay
)

 

[Steven P]

Have a look at this to create a true colour layer:

 

(createlayer "Layer" '(75 150 225) "Continuous" 0)

 

Noting that colour is a list of RGB variables, so all you need to search out is the conversion from what the hatch colour gives you that

[Dien nguyen]

With specifies true color i can create layer with layer, but i want get hatch color to match layer color

[Steven P]

You can get the hatch colour something like this

 

(defun c:getcolour ( / MyEnt MyColour)
  (setq MyEnt (entget (car (entsel "Select Entity"))))
  (if (= (assoc 420 MyEnt) nil)
    (setq MyColour (cdr (assoc 62 MyEnt)))
    (setq MyColour (cdr (assoc 420 MyEnt)))
  ) ; end if
  MyColour
)

 

then convert thrue colour to rgb

[Lee Mac]

An AcCmColor object is independent of the entity (graphical/non-graphical) to which it applies; hence, you can skip the testing for colour type altogether:

 

(defun c:hn ( / e h n x )
    (if
        (and (setq h (car (entsel "\nSelect hatch: ")))
            (progn
                (while
                    (and (setq e (car (entsel "\nSelect text: ")))
                        (not
                            (and
                                (= "TEXT" (cdr (assoc 0 (setq x (entget e)))))
                                (snvalid (setq n (cdr (assoc 1 x))))
                            )
                        )
                    )
                    (princ "\nText not valid for use as a layer name.")
                )
                e
            )
        )
        (vla-put-truecolor
            (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) n)
            (vla-get-truecolor (vlax-ename->vla-object h))
        )
    )
    (princ)
)

 

[Steven P]

Thanks Lee - I learn something every time you post!

[Dien nguyen]

Thank Lee Mac, I'm happy to get your feedback, it works great, I used many of your lisp. 

[Lee Mac]

You're most welcome