Adjusting blocks to polyline layer lisp

[yu85.info]

Hi, I have a drawing (DWG attached) with many blocks (name-"POINT") along polylines. The insertion point of the blocks is snapped to a vertex on the polyline. I wish to change the layer of the block according to the layer of the polyline it is snapped to. Is there a way to do it with a lisp? there are many blocks and to do it manually will take a lot of time.
Thanks a lot for any help.

[CADaSchtroumpf]

Hi,

Try this for testing.

(defun c:test ( / js flag_ps flag_ucs n ent l_dxf lay_nam s_dxf 2d_lsom nw_pt js_bl e dxf_e)
 (setq js (ssget "_X" '((0 . "POLYLINE") (-4 . "&=") (70 . 😎 (8 . "UT-*") (410 . "Model"))))
 (cond
  (js
   (setvar "cmdecho" 0)
   (command "_.undo" "_begin")
   (if (zerop (getvar "tilemode"))
    (progn
     (setq flag_ps T)
     (setvar "tilemode" 1)
    )
    (setq flag_ps nil)
   )
   (if (zerop (getvar "worlducs"))
    (progn
     (setq flag_ucs T)
     (command "_.ucs" "_world")
    )
    (setq flag_ucs nil)
   )
   (command "_.zoom" "_extent")
   (repeat (setq n (sslength js))
    (setq l_dxf (entget (setq ent (ssname js (setq n (1- n)))))
          lay_nam (cdr (assoc 8 l_dxf))
          s_dxf (entget (entnext (cdar l_dxf)))
          2d_lsom nil
    )
    (while (/= (cdr (assoc 0 s_dxf)) "SEQEND")
     (if (zerop (boole 1 207 (cdr (assoc 70 s_dxf))))
      (setq nw_pt (cdr (assoc 10 s_dxf))
            2d_lsom (cons (list (car nw_pt) (cadr nw_pt) 0.0) 2d_lsom)
      )
     )
     (setq s_dxf (entget (entnext (cdar s_dxf))))
    )
    (foreach pt 2d_lsom
      (setq js_bl (ssget "_C" (mapcar '- pt '(0.05 0.05 0.0)) (mapcar '+ pt '(0.05 0.05 0.0)) '((0 . "INSERT") (2 . "POINT"))))
      (cond
        (js_bl
          (ssdel ent js_bl)
          (repeat (setq i (sslength js_bl))
            (setq
              e (ssname js_bl (setq i (1- i)))
              dxf_e (entget e)
            )
            (entmod (subst (cons 8 lay_nam) (assoc 8 dxf_e) dxf_e))
          )
        )
      )
    )
   )
   (command "_.zoom" "_previous")
   (if flag_ucs (command "_.ucs" "_previous"))
   (if flag_ps (setvar "tilemode" 0))
   (command "_.undo" "_end")
   (setvar "cmdecho" 1)
  )
 )
 (prin1)
)

[Sea-Haven · Accepted solution]

Try this

(defun co-ords2xy (xyz co-ords / I XY )
(setq co-ordsxy '())
(if (= xyz 2)
  (progn
    (setq I 0)
    (repeat (/ (length co-ords) 2)
    (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
    (setq co-ordsxy (cons xy co-ordsxy))
    (setq I (+ I 2))
    )
  )
)
(if (= xyz 3)
  (progn
    (setq I 0)
    (repeat (/ (length co-ords) 3)
    (setq xy (list (nth i co-ords)(nth (+ I 1) co-ords)(nth (+ I 2) co-ords) ))
    (setq co-ordsxy (cons xy co-ordsxy))
    (setq I (+ I 3))
    )
  )
)
(princ)
)

(defun c:blklay ( / ss ss2 obj entname layn p1 p2 p3 p4 pts ent2)
(prompt "Select plines ")
(setq ss (ssget '((0 . "*POLYLINE"))))

(repeat (setq x (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
  (setq entname (vlax-get obj 'objectname))
  (if (= entname "AcDb3dPolyline")
    (setq 23d 3)
    (setq 23d 2)
  )
  (co-ords2xy 23d (vlax-get obj 'coordinates))
  (setq layn (vlax-get obj 'Layer))
  (foreach pt co-ordsxy
    (setq p1 (mapcar '+ pt (list -0.02 0.02 0.0)))
    (setq p2 (mapcar '+ pt (list -0.02 -0.02 0.0)))
    (setq p3 (mapcar '+ pt (list 0.02 -0.02 0.0)))
    (setq p4 (mapcar '+ pt (list 0.02 0.02 0.0)))
    (setq pts (list p1 p2 p3 p4 p1))
    (setq ss2 (ssget "F" pts '((0 . "INSERT")(2 . "POINT"))))
    (if (= ss2 nil)
      (princ)
      (progn
       (setq ent2 (entget (ssname ss2 0)))
       (entmod (subst (cons 8 layn) (assoc 8 ent2) ent2))
      )
    )  
  )
)

(princ)
)
(c:blklay)

[yuval.infratek]

Thank you very much friend. You saved me a lot of time.

[yu85.info]

@Sea-Haven If it is ok, could you please modify the code you wrote to so it will switch the block's layer to the layer of the polyline but with the suffix "-T".

For example, if the polyline is in layer named "GOOD" the block will be in layer "GOOD-T"

All the layers ("GOOD" and "GOOD-T") are already exists in the drawing and not need to be created.

Thank you very very much