Leaderboard

OK, try this. It works in my test. (defun LM:unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))) (defun BB:setByBlock (nam / blc blk) (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq blk (vla-item blc nam)) (vlax-for x blk (if (= "AcDbBlockReference" (vlax-get-property x 'objectname)) (BB:setByBlock (vlax-get-property x 'effectivename))) (if (= "0" (vlax-get-property x 'layer)) (vlax-put-property x 'lineweight acLnWtByBlock)) ) ) (vl-load-com) (defun c:bf ( / c_doc sel cnt obj col) (setq c_doc (vla-get-activedocument (vlax-get-acad-object))) (princ "\nSelect blocks : ") (setq sel (ssget '((0 . "INSERT")))) (cond (sel (repeat (setq cnt (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq cnt (1- cnt))))) (cond ( (= :vlax-true (vlax-get-property obj 'isdynamicblock)) (setq col (cons (vla-get-effectivename obj) col) col (cons (vla-get-name obj) col) ) ) (t (setq col (cons (vla-get-effectiveName obj) col))) );end_cond );end_repeat (setq col (LM:unique col)) (foreach x col (BB:setByBlock x)) ) ( (princ "\nNothing Selected")) );end_cond (vla-regen c_doc acActiveViewport) (princ) );end_defun

Try this, there was a variable mis-spelling in one branch of a condition statement (defun LM:unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))) (defun BB:setByBlock (nam / blc blk) (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq blk (vla-item blc nam)) (vlax-for x blk (if (= "0" (vlax-get-property x 'layer)) (vlax-put-property x 'lineweight acLnWtByBlock))) ) (vl-load-com) (defun c:bf ( / c_doc sel cnt obj col) (setq c_doc (vla-get-activedocument (vlax-get-acad-object))) (princ "\nSelect blocks : ") (setq sel (ssget '((0 . "INSERT")))) (cond (sel (repeat (setq cnt (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq cnt (1- cnt))))) (cond ( (= :vlax-true (vlax-get-property obj 'isdynamicblock)) (setq col (cons (vla-get-effectivename obj) col) col (cons (vla-get-name obj) col) ) ) (t (setq col (cons (vla-get-effectiveName obj) col))) );end_cond );end_repeat (setq col (LM:unique col)) (foreach x col (BB:setByBlock x)) ) ( (princ "\nNothing Selected")) );end_cond (vla-regen c_doc acActiveViewport) (princ) );end_defun

@hanhphuc See attached pl1v2004.dwg

Hello, I've modified my code as per your requirement, I've kept it simpler so that you can understand it step by step. For assigning colors you can add colors to text directly as shown in below image. Please try following code in attached: (defun c:test (/ laycol layer s i o v c) (defun laycol (o) (if (setq o (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)) ) (vla-get-layer o) ) ) (vla-get-color o) ) ) (defun layer (name color) (entmake (list '(0 . "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 name) (cons 70 0) (cons 62 color) (cons 6 "Continuous") ) ) ) (if (setq s (ssget "_:L" '((0 . "*TEXT")))) (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))) v (strcat "A-_" (vla-get-textstring o) "-N") c (vla-get-color o) ) (if (eq c 256) (setq c (laycol o)) ) (if (not (tblsearch "layer" v)) (progn (layer v c) (princ (strcat "\nNew layer created : " v)) ) (princ (strcat "\nLayer exists : " v)) ) ) ) (princ) )

Glad I could help. I tried to calculate the point, but I was a bit brain dead, and the number of conditions kept growing; so it was easier to use the ray and find the closest intersection point.

Unfortunately the update to the forum software implemented several months back caused BBCode formatting tags embedded within code to become visible in code blocks, and also removed every instance of "8)" within code, breaking thousands of programs which previously ran successfully. I've now updated my earlier posts to fix the code.