[编程交流] 将块插入到多线端点

---------
;;-----------------=={ Block At Vertices }==------------------;;
;;                                                            ;;
;;  Inserts a Block at each vertex of selected Polylines,     ;;
;;  with the exclusion of start/end vertices                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
(defun c:BlockAtVertices ( / *error* _StartUndo _EndUndo _Insert _AngleAtParam doc block ss )
 (vl-load-com)
 ;; © Lee Mac 2010
 (setq block "endtick.dwg") ;; << Block Name
 (defun *error* ( msg )
   (and doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )
 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )
 (defun _Insert ( block point rotation )
   (entmakex
     (list
       (cons 0 "INSERT")
       (cons 2  block)
       (cons 10 point)
       (cons 50 rotation)
     )
   )
 )
 (defun _AngleatParam ( entity param )
   (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv entity param))
 )       
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (cond
   ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
     (princ "\n** Current Layer Locked **")
   )
   ( (not
       (or
         (and (tblsearch "BLOCK" (vl-filename-base block))
           (setq block (vl-filename-base block))
         )
         (and
           (setq block
             (findfile
               (strcat block
                 (if (eq "" (vl-filename-extension block)) ".dwg" "")
               )
             )
           )
           (
             (lambda ( / ocm )
               (setq ocm (getvar 'CMDECHO)) (setvar 'CMDECHO 0)
               (command "_.-insert" block) (command)
               (setvar 'CMDECHO ocm)
               
               (tblsearch "BLOCK" (setq block (vl-filename-base block)))
             )
           )
         )
       )
     )
     (princ "\n** Block not Found **")
   )
   ( (not (setq ss (ssget '((0 . "*POLYLINE")))))
     (princ "\n*Cancel*")
   )
   (t
     (_StartUndo doc)
    
     (
       (lambda ( i / e )
         (while (setq e (ssname ss (setq i (1+ i))))
           (
             (lambda ( param end )
               (while (< (setq param (1+ param)) end)
                 (_Insert block (vlax-curve-getPointatParam e param) (_AngleAtParam e param))
               )
             )
             (vlax-curve-getStartParam e) (vlax-curve-getEndParam e)
           )
         )
       )
       -1
     )
     (_EndUndo doc)
   )
 )
 (princ)
)
---------

 (defun c:aaa ()
   (vl-load-com)
   (setq *model-space* 
          (vla-get-modelspace 
             (vla-get-activedocument 
                (vlax-get-acad-object))))
   (setq obj (vlax-ename->vla-object (car (entsel))))
   (setq c (vlax-get obj "Coordinates") i 0)
   (repeat (/ (length c) 3)
     (setq x (nth i c) y (nth (1+ i) c) z (nth (+ 2 i) c))
     (vla-addtext *model-space* (rtos z 2) (vlax-3d-point (list x y 0.0)) 3.0)
     (setq i (+ i 3)) 
   )
   (princ)
 )