[编程交流] 在上的每个夹点处放置一个挡块

(defun c:foo ()
   (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) 2)
  (setq x (nth i c) y (nth (1+ i) c))
  (vla-addcircle *model-space* (vlax-3d-point (list x y 0.0)) 3.0)
  (setq i (+ i 2)) 
   )
   (princ)
 )
 

(defun c:test (/ isattributed blk s i)
 ;;        Tharwat 6/9/2015        ;;
 (defun isattributed (doc name / yes)
   (vlax-for o (vla-item (vla-get-blocks doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq yes t)
     )
   )
   yes
 )
 (if (and (/= ""
              (setq blk
                     (getstring
                       t
                       "\nSpecify Block name to place at each coordinates of a LWPolyline :"
                     )
              )
          )
          (tblsearch "BLOCK" blk)
          (if (not (isattributed
                     (vla-get-activedocument (vlax-get-acad-object))
                     blk
                   )
              )
            t
            (progn (princ "\nBlock name is attributed !!") nil)
          )
          (setq s (ssget '((0 . "LWPOLYLINE"))))
     )
   (repeat (setq i (sslength s))
     (foreach p (entget (ssname s (setq i (1- i))))
       (if (eq (car p) 10)
         (entmake (list '(0 . "INSERT") p (cons 2 blk)))
       )
     )
   )
   (princ
     "\nBlock name is not found or selection is not a LWPolyline "
   )
 )
 (princ)
)(vl-load-com)

(defun c:test ( / blk def enx idx sel vtx )
   (while
       (and (/= "" (setq blk (getstring t "\nBlock name: ")))
           (cond
               (   (null (setq def (tblsearch "block" blk)))
                   (princ "\nBlock not found.")
               )
               (   (= 2 (logand 2 (cdr (assoc 70 def))))
                   (princ "\nBlock is attributed.")
               )
           )
       )
   )
   (if (and (/= "" blk) (setq sel (ssget '((0 . "LWPOLYLINE")))))
       (repeat (setq idx (sslength sel))
           (setq enx (entget (ssname sel (setq idx (1- idx)))))
           (while (setq vtx (assoc 10 enx))
               (entmake (list '(0 . "INSERT") (cons 2 blk) vtx))
               (setq enx (cdr (member vtx enx)))
           )
       )
   )
   (princ)
)