Topic: Method: Force LTYPE and COLOR of line-work objects

[JohnK]

I am a bit out of practice when it comes to writing AutoLisp code (but i didnt know it was this bad). I needed to create a small helper app that forces the color and linetype of some line-work (line, circle, polyline, arc) to a hidden ltype and a screened color.

I found myself writing this; is that right or am I just that out of practice?
-that is to say:
1. If the color and linetype is BYLAYER then they dont show up in the entlist?
2. I remember the VL prop list being longer (color isnt in there).

I'm not going to include the rest of the code (where I check for loaded line types, and the other stuff I did because so-far its just flat out embarrassing; it looks like C *lol*).

Code: [Select]

(setq elist (entget (ssname ss cntr)))

(if (assoc 62 elist)
  (setq elist (subst '(62 . 169) (assoc 62 elist) elist))
  (setq elist (append elist '((62 . 169))))
  )
;; set the color

(if (assoc 6 elist)
  (setq elist (subst '(6 . "HIDDEN2") (assoc 6 elist) elist))
  (setq elist (append elist '((6 . "HIDDEN2"))))
  )
;; set the ltype

(entmod elist)
;; modify it

[alanjt]

All looks good to me.

If an object is ByLayer (Color, Linetype) it will not showup in an entity data dump.

I've also noticed that color does not show up with a vlax-dump, but the object will still accept vla-get-color/vla-put-color.

[JohnK]

Ah, good. Thank you. I think i will go the VL route then.

I havent done and Entity creation/modification stuff in a long time.

[David Bethel]

I'd suggest testing the linetype table definition to see if it exists.  You can error out if the linetype hasn't been loaded.  -David

[alanjt]

I'd suggest testing the linetype table definition to see if it exists.  You can error out if the linetype hasn't been loaded.  -David

I'm not going to include the rest of the code (where I check for loaded line types, and the other stuff I did because so-far its just flat out embarrassing; it looks like C *lol*).

[JohnK]

I'd suggest testing the linetype table definition to see if it exists.  You can error out if the linetype hasn't been loaded.  -David

Thanx David but I'm one step ahead of ya.

This is what i will prolly use (because i just want it done). Don't laugh too hard BTW.

Code: [Select]

(defun C:hh ( / *myerror* ERROR-LST-
                build-name-list
                process-on-drawing
                get-drawing-dictionary-list
                )
  (cond
    ;; Attempt to load the ActiveX object model.
    ((> 15 (atoi (getvar 'ACADVER)))
     ;;  AutoCAD 14 and older
     (princ "\nERROR: This lisp requires access to the ActiveX object model.\n")
     (exit))
    ((vl-load-com))
    );_ end cond
 
  (defun build-name-list ( lst )
    ;; given a list of raw dic entries this proced
    ;; will report entity names
    (if (null lst)
      nil
      (cons (cdr (assoc 2 (car lst)))
            (build-name-list (cdr lst)))) )

  (defun process-on-drawing ( process )
    (eval process) )

  (defun get-drawing-dictionary-list ( what / x lst)
    ;; retrieve a list of drawing dictionary entries
    (while (setq x (tblnext what (not x)))
           (setq lst (cons x lst))) )

  (setq *acadobject*
        (cond
          (*acadobject*)
          ((vlax-get-acad-object)))
        *activedocument*
        (cond
          (*activedocument*)
          ((vla-get-activedocument *acadobject*))) )
  (defun *myerror* (msg)
    (command) (command)
    (mapcar 'eval ERROR-LST-)
    (setq *error* olderror)
    (if (not (eq msg ""))
      (progn
        (princ msg)
        (quit)) )
    )
  (if (not
        (member
  "HIDDEN2"
          (build-name-list
            (process-on-drawing
              '(get-drawing-dictionary-list "LTYPE")))))
    (*myerror* "\nLinetype not loaded") )

  (vla-StartUndoMark *activedocument*)

  (setq ss (ssget
             '((-4 . "<OR")
               ;; allow only these types to be selected.
               (0 . "LINE")
               (0 . "LWPOLYLINE")
               (0 . "CIRCLE")
               (0 . "ARC")
               (-4 . "OR>")))
        cntr 0)
 
  (if (eq (type ss) 'PICKSET)
    (repeat (sslength ss)
            (setq ename (ssname ss cntr)
                  elist (entget ename)
                  obj (vlax-ename->vla-object ename))
            (if (vlax-property-available-p Obj 'Linetype)
              (vlax-put-property Obj 'Linetype "HIDDEN2"))
            (if (vlax-property-available-p obj 'Color)
              (vlax-put-property Obj 'Color 169))
            (setq cntr (1+ cntr))
            (vlax-Release-Object Obj) )

    (*myerror* "\nNo selection")

    )  ;_end if

  (vla-EndUndoMark *activedocument*)
  (*myerror* "")
 (princ)
)

[JohnK]

I'd suggest testing the linetype table definition to see if it exists.  You can error out if the linetype hasn't been loaded.  -David

I'm not going to include the rest of the code (where I check for loaded line types, and the other stuff I did because so-far its just flat out embarrassing; it looks like C *lol*).

Yeah, *lol* and now it looks like Scheme.

[David Bethel]

OOPS.  Didn't see that the first time around

I've used lots of variations of stepping thru a selection set over the years.

This seems to be about the simplest and yet still readable and needs no real error trapping

Code: [Select]


  (and (setq i -1
            ss (ssget '((0 . "ARC,CIRCLE,LINE,LWPOLYLINE"))))
       (while (setq en (ssname ss (setq i (1+ i))))
              (setq ed (entget en))
               ;;;DO YOUR THING HERE
              ))


My $0.02  -David

[dgorsman]

A little more on VL and color settings here: http://www.theswamp.org/index.php?topic=35588.0.  (vl-put-Color ...) is probably a little more direct but I like the utility of setting the ACI of the AcCmColor object once then assigning it to the different objects, along with its ability to handle the TrueColor settings some of our third-party software forces on us.

[alanjt]

Code: [Select]

(mapcar
  (function
    (lambda (prop val)
      (vlax-put-property object prop val)
    )
  )
  '(Color LineType)
  '(169 "HIDDEN2")
)

Code: [Select]

(mapcar (function vlax-put-property)
        (list object object)
        '(Color LineType)
        '(169 "HIDDEN2")
)

[JohnK]

hehe...too late for me guys (but you guys can keep going). Mines done and on the network. besides, I am all burned out on AutoLisp. I dont really want to do it anymore.

Thanx though.