Trying to assign Splines in a block to a layer in a LISP

[Anonymous]

I am trying to assign Splines in a block to a layer.  I'm pretty sure that I have the obj name right, AcDbSpline, but the LISP routine doesn't make the assignment; it loads ok with no error messages, gotta be some formatting trick I haven't mastered.  Thanks in advance for any help!

[hmsilva]

try to change

(if
   (eq (vla-get-objectname obj) "AcDbSpline")
   (vla-put-color obj 256)
   (setq frm (cons obj frm)))

to

(if (eq (vla-get-objectname obj) "AcDbSpline")
   (progn (vla-put-color obj 256)
          (setq frm (cons obj frm))
   )
)

Hope this helps,
Henrique

[_Tharwat · Accepted solution]

Hi,

You have placed the codes in the wrong place  so replace the following part:

(vlax-for obj  b
  (if
    (eq (vla-get-objectname obj) "AcDbLine")
     (progn
       (setq anglee (vla-get-angle obj))
       (vla-put-color obj 256)
       (cond
         ((equal anglee 0.2705047 1e-6)
          (setq mdr (cons obj mdr)))
         ((equal anglee 0.34036 1e-5)
          (setq mdr (cons obj mdr)))
         ((equal anglee 1.0559 1e-4)
          (setq mdr (cons obj mdr)))
         ((equal anglee 1.125758 1e-6)
          (setq mdr (cons obj mdr)))
         (t (setq rol (cons obj rol)))
         )
       )
     )
  (if
    (eq (vla-get-objectname obj) "AcDbSpline")
     (progn
       (vla-put-color obj 256)
       (setq frm (cons obj frm)))
     )
  )

[Anonymous]

Thanks for the help guys...one more thing though; I have to do a REGEN to get the blue to show up, any particular reason for that?

[_Tharwat]

Thank you for the Kudos Henrique.

@Anonymous wrote:

Thanks for the help guys...one more thing though; I have to do a REGEN to get the blue to show up, any particular reason for that?

---

You already have the codes that should generate all viewports but you may also placed it in the wrong place ! anyway just place the codes as follows:

(if
    (setq ss (ssget ":L" '((0 . "INSERT"))))
    (progn
      .............................................
      (vla-Regen acdoc acactiveviewport)
    )
  )

[Anonymous]

Here's the update LISP file and the block I'm working on...note that the LISP has the (vla-Regen acdoc acactiveviewport) at the end...but no dice, still have to regen every time.  It's a mystery...

[Anonymous]

meh...I just added (command "regen") at the end.

[_Tharwat · Accepted solution]

Hi,

You did not follow what I have said in my last reply and that's why it did not work for you. 

Firstly you need to place the vla-regen function at the end of the progn function.

Secondly I see you have extra char 's' that stops the program before it finishes normally.

Modified according to issues you have raised.

;Change color and/or layer of objects inside blocks
;Author Stefan M.                                  
;version 2.03 - 20.05.2016
(defun c:curveblk ( / a acdoc anglee blocks arr def e frm i l la lg p1 p2 rol sanglee sns ss mdr)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
        blocks (vla-get-blocks acdoc))
  (foreach x '(("HILMOT FRAMES" 4) ("HILMOT MDR" 3) ("HILMOT ROLLER" 8) ("HILMOT SENSOR" 1))
     (or
       (tblsearch "layer" (car x))
       (entmake
         (list
           '(0 . "LAYER")
           '(100 . "AcDbSymbolTableRecord")
           '(100 . "AcDbLayerTableRecord")
           (cons 2 (car x))
           '(70 . 0)
           (cons 62 (cadr x))
           '(6 . "Continuous")
         )
       )
     )
   )
  (if
    (setq ss (ssget ":L" '((0 . "INSERT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
        (if
          (not (member (setq def (vla-item blocks (vlax-get e (if (vlax-property-available-p e 'EffectiveName) 'EffectiveName 'Name)))) l))
          (setq l (cons def l))
        )
      )
      (foreach b l
        (setq frm nil
              sns nil
              rol nil
              mdr nil
              )   
(vlax-for obj  b
  (if
    (eq (vla-get-objectname obj) "AcDbLine")
     (progn
       (setq anglee (vla-get-angle obj))
       (vla-put-color obj 256)
       (cond
         ((equal anglee 0.2705047 1e-6)
          (setq mdr (cons obj mdr)))
         ((equal anglee 0.34036 1e-5)
          (setq mdr (cons obj mdr)))
         ((equal anglee 1.0559 1e-4)
          (setq mdr (cons obj mdr)))
         ((equal anglee 1.125758 1e-6)
          (setq mdr (cons obj mdr)))		
	 ((equal anglee 0.087266 1e-6) 
	  (setq SNS (cons obj sns)))
	 ((equal anglee 0.872665 1e-6) 
          (setq SNS (cons obj sns)))
         (t (setq rol (cons obj rol)))
         )
       )
     )
  (if
    (eq (vla-get-objectname obj) "AcDbSpline")
     (progn
       (vla-put-color obj 256)
       (setq frm (cons obj frm)))
     )
  )
        )
        (mapcar
         '(lambda (o la)
            (mapcar '(lambda (a) (vla-put-layer a la)) o)
          )
          (list frm rol sns mdr)
         '("HILMOT FRAMES" "HILMOT ROLLER" "HILMOT SENSOR" "HILMOT MDR")
        )
      (vla-Regen acdoc acactiveviewport)
      )
    )
(princ)
)
 

[hmsilva]

---

@_Tharwat wrote:

Thank you for the Kudos Henrique.

... 

---

You're welcome, my friend!

Cheers
Henrique

[_Tharwat]

@Anonymous 

Have you had the chance to try the codes that I have modified for you?

[Anonymous]

I'll double-check tomorrow, Monday morning.  That was a loooong day, I did end up getting the result I wanted eventually, but I will let you know specifically.  Thanks!

[Anonymous]

Thanks Tharwat, I just tried your solution, works great!.  I have noticed that every now and then, when I try to save a LISP file, I miss the ctrl key and end up putting a stray "s" in somewhere.  Thanks especially for reminding me of that, I may map the save command to an extra keyboard with a single key press just to avoid that mistake!!

[_Tharwat]

---

@Anonymous wrote:

Thanks @_Tharwat, I just tried your solution, works great!.  I have noticed that every now and then, when I try to save a LISP file, I miss the ctrl key and end up putting a stray "s" in somewhere.  Thanks especially for reminding me of that, I may map the save command to an extra keyboard with a single key press just to avoid that mistake!!

---

You are welcome - and thank you for the kudos.