sadefa 发表于 2022-7-5 16:44:48

块多段线现有代码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)
)
阻尼器。lsp
输出图纸

satishrajdev 发表于 2022-7-5 17:13:56

试试这个,可以处理多条多段线:
(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)
)

sadefa 发表于 2022-7-5 17:35:32

非常感谢。它工作完美!

satishrajdev 发表于 2022-7-5 17:50:30

不客气
页: [1]
查看完整版本: 块多段线现有代码e