块多段线现有代码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
输出图纸 试试这个,可以处理多条多段线:
(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)
) 非常感谢。它工作完美! 不客气
页:
[1]