Add Block onto polyline vertices

[christoff900]

Hi Guys
I have this lisp that lets me add a block to polyline vertices but it only lets me select one polygon at a time.   I would like to lasso about 50 polygons at once. Im sure its an easy fix but I dont understand lisp language.

PLB.LSP

[christoff900]

And actually the ultimate goal would be too get Cogo points on the vertices of many many polygons all at once. (and points have to have elevation of the polyline vertice)

[mhupp]

Select block in drawing then the polylines you wish to copy to.

https://ibb.co/RphCM36

 

;;----------------------------------------------------------------------------;;
;; Copy Block from Insertion Point to Polylines Vertices
(defun C:Copy2Poly (/ blk BP SS cords)
  (setvar 'cmdecho 0)
  (if (setq blk (car (entsel "\nSelect Block to Copy")))
    (progn
      (redraw blk 3)
      (setq BP (cdr (assoc 10 (entget blk)))) ;base point of block
      (if (setq SS (ssget '((0 . "*POLYLINE"))))
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (foreach pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))) 
            (command "_.Copy" blk "" "_non" BP "_non" PT)
          )
        )
      )
    )
    (prompt "\nNothing Selected try again")
  )
  (setvar 'cmdecho 1)
  (princ) 
)

 

Edited November 17, 2022 by mhupp

[christoff900]

@mhupp Thankyou! that works great, but it is not applying the elevation of the polyline vertices to the block. Is that an easy fix?

[mhupp]

If the ployline is 2d it will only have x and y cords. have to add the elevation of the polyline to each vertex. You could use the old code if the block was on the same elevation.

 

;;----------------------------------------------------------------------------;;
;; Copy Block from Insertion Point to Polylines Vertices
(defun C:Copy2Poly (/ blk BP SS cords)
  (setvar 'cmdecho 0)
  (if (setq blk (car (entsel "\nSelect Block to Copy")))
    (progn
      (redraw blk 3)
      (setq BP (cdr (assoc 10 (entget blk))))
      (if (setq SS (ssget ":L" '((0 . "*POLYLINE"))))
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (setq z (cdr (assoc 38 (setq x (entget ent))))) ;elevation of 2d polyline
          (foreach pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) x))
            (setq pt (append pt (list z))) ;adds elevation of 2d polyline to point
            (command "_.Copy" blk "" "_non" BP "_non" pt)
          )
        )
      )
    )
    (prompt "\nNothing Selected try again")
  )
  (redraw blk 4)
  (setvar 'cmdecho 1)
  (princ)
)

 

Edited November 17, 2022 by mhupp

[BIGAL]

May be worth checking (assoc 0 for the different type of polylines 2D, 3d or old and get 2d or 3d points. (setq lst (vlax-get (vlax-ename->vla-object obj) 'coordinates)) returns XY or XYZ.

 

(0 . "POLYLINE") (100 . "AcDb3dPolyline")

 

(0 . "LWPOLYLINE")(100 . "AcDbPolyline")

[mhupp]

Updated code using some vlax funcitons I forgot about. it calculates each point of the vertex rather then pulling it from the dxf code.

So this will work with 3D, 2D, 2D polylines at elevation, and 2D polyline that are 3d rotated. and should probably run faster since its not using command.

 

)
;;----------------------------------------------------------------------------;;
;; Copy Block from its Insertion Point to Polylines Vertices
(defun C:Copy2Poly (/ blk BP SS cords)
  (vl-load-com)
  (if (setq blk (car (entsel "\nSelect Block to Copy")))
    (progn
      (redraw blk 3)
      (if (setq SS (ssget '((0 . "*POLYLINE"))))
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
          (setq x (vla-copy (setq obj (vlax-ename->vla-object blk))))
          (vla-move x BP (vlax-curve-getStartPoint ent)) ;gets point at start of polyline
          (setq i 1)
          (while (< i (1+ (vlax-curve-getendparam ent)))
            (setq pt (vlax-curve-getPointAtParam ent i)) ;gets point at vertext # (x,y,z) vertex 0 = start
            (setq x (vla-copy obj))
            (vla-move x BP pt)
            (setq i (1+ i))
          )
        )
      )
    )
    (prompt "\nNothing Selected try again")
  )
  (redraw blk 4)
  (princ)
)

 

 

 

 

Edited November 19, 2022 by mhupp