[编程交流] 块多段线现有代码e

(defun C:dampers(/ ang cumm_dist dis dist_list leng obj pt)
 (vl-load-com)
;; build master list of the distances, starting from 0.0 - important!
(setq dist_list '(2.0))
(setq cumm_dist (apply '+ dist_list))
 
(setq dis 0.0)
(setq obj (vlax-ename->vla-object (car (entsel "\n >> Select profile >>"))))
(setq leng (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))
;; check if pline length is not less than the cumulative distance 
(if (< leng cumm_dist)
   (progn
     (alert "Pline length is less then summary distance")
     (princ)
     )
   
(while (< dis cumm_dist)
 (setq dis (+ dis (car dist_list)))
 (setq pt (vlax-curve-getpointatdist obj dis))
;;;***
;;to insert block named "vibr":
;; get angle:
(setq ang (angle '(0 0 0)
              (vlax-curve-getfirstderiv obj
                (vlax-curve-getparamatpoint obj pt))))
;;insert block:  
 (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
   'InsertBlock pt "vibr" 1 1 1 ang);***
 )
 (princ)
 )

(defun c:test (/ a b c d i)
 (vl-load-com)
 (princ "\n >> Select profiles >>")
 (if (and (setq a (ssget '((0 . "*polyline"))))
   (setq d (getreal "\nSpecify Distance Interval : "))
     )
   (repeat (setq i (sslength a))
     (setq b (vlax-ename->vla-object (ssname a (setq i (1- i)))))
     (setq c (vla-get-length b))
     (if (> c d)
(foreach x (list (vlax-curve-getpointatdist b d)
                 (vlax-curve-getpointatdist b (- c d))
           )
  (vla-insertblock
    (vla-get-modelspace
      (vla-get-activedocument (vlax-get-acad-object))
    )
    (vlax-3d-point x)
    "vibr"
    1
    1
    1
    (angle '(0 0 0)
           (vlax-curve-getfirstderiv
             b
             (vlax-curve-getparamatpoint b x)
           )
    )
  )
)
     )
   )
 )
 (princ)
)