new layers from objects

[jim78b]

i have this lisp that convert all object colour and linetype in layers but don't work give me

; error: no function definition: VLA-GET-LTSCALE

(vl-load-com)
(defun c:classify ( / ss ssl index obj color linetype ltscale str layertable newlayername)
 (princ "\n select object to classify")
 (if (setq ss (ssget))
    (progn 
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
        (setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ss index))))))
        (setq color (vla-get-color obj))
        (if (= color 256) ; if by layer
           (setq color (cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj)))))
        )
        (setq color (vl-princ-to-string color))
        (setq linetype (vl-princ-to-string (vla-get-linetype obj)))
        (if (= linetype "ByLayer") ; if by layer
           (setq linetype (cdr (assoc 6 (tblsearch "LAYER" (vla-get-layer obj)))))
        )
        (setq linetype (vl-princ-to-string linetype))
        (setq ltscale (vl-princ-to-string (vla-get-ltscale obj)))
        (setq str (strcat "color-"color "_lt-" linetype "_lts-" ltscale))
        (setq layertable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
        (if (= (tblsearch "LAYER" str) nil)
           (progn 
             (setq newlayername (vla-add layertable str))
             (vla-put-color newlayername color)
             (vla-put-linetype newlayername linetype)
             (vla-put-ltscale newlayername ltscale)
           ); end of progn
        ); end of if    
        (vlax-put-property obj 'layer str)
        (setq index (+ index 1))
      );end of repeat
    );end of progn
 );end of if

(princ)
);end of defun

[ВeekeeCZ]

Are you the author?

You should post some sample dwg to test.

I've fixed the obvious, didn't think it through in detail.

(vl-load-com)
(defun c:test ( / ss ssl index obj color linetype ltscale str layertable newlayername)
  (princ "\n select object to classify")
  (if (setq ss (ssget))
    (progn
      (setq ssl 0)
      (setq ssl (sslength ss))
      (setq index 0)
      (setq str "")
      (repeat ssl
	(setq obj (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname ss index))))))
	(setq color (vla-get-color obj))
	(if (= color 256) ; if by layer
	  (setq color (cdr (assoc 62 (tblsearch "LAYER" (vla-get-layer obj)))))
	  )
	(setq color (vl-princ-to-string color))
	(setq linetype (vl-princ-to-string (vla-get-linetype obj)))
	(if (= linetype "ByLayer") ; if by layer
	  (setq linetype (cdr (assoc 6 (tblsearch "LAYER" (vla-get-layer obj)))))
	  )
	(setq ltscale (vla-get-LineTypescale obj))
	(setq str (strcat "color-" (vl-princ-to-string color) "_lt-" (vl-princ-to-string linetype) "_lts-" (vl-princ-to-string ltscale)))
	(setq layertable (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
	(if (= (tblsearch "LAYER" str) nil)
	  (progn
	    (setq newlayername (vla-add layertable str))
	    (vla-put-color newlayername color)
	    (vla-put-linetype newlayername linetype)
	    ); end of progn
	  ); end of if
	(vlax-put-property obj 'layer str)
	(setq index (+ index 1))
	);end of repeat
      );end of progn
    );end of if
  
  (princ)
  );end of defun

[jim78b]

NO i am not the author

[Sea-Haven]

There is still 1 mistake will let you find it. When looking for stuff like Linetypescale use Dumpit.lsp to check for correct property name. 

[jim78b]

sorry i am not able to coding

[devitg]

@jim78b Why not to start coding?

[jim78b]

How many airs you give yourself.
 if I knew how to program I would have given help without being argumentative

[Sea-Haven]

What is wrong here, please this is for Jim78 only needs to learn so dont post correction.

(vla-put-color newlayername color)
(vla-put-linetype newlayername linetype)
(vla-get-LineTypescale newlayername ltscale)

[jim78b]

Thanks i will try.

Have a good day and thanks for understanding.

[jim78b]

sorry don't work in nested blocks