沿直线移动直线/多段线
大家好，我该怎么做？
将直线/多段线沿直线（y）移动以接触多段线
我是一个起草人，而不是你可能已经猜到的程序员。
谢谢你的时间。
这很有趣。然而，你应该学会自己编码。
(defun c:MLTC (/ #SS #Curve #Int1 #Int2 #Pnt)
;; Move Lines to Curve; Alan J. Thompson, 03.16.10
(vl-load-com)
(cond
((and (princ "\nSelect Line object(s) to move: ")
(setq #SS (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
(setq #Curve (car (entsel "\nSelect curve to move text to: ")))
(or (vl-position (cdr (assoc 0 (entget #Curve))) '("LWPOLYLINE" "LINE" "ARC"))
(alert "Invalid selected object!")
) ;_ or
(setq #Curve (vlax-ename->vla-object #Curve))
) ;_ and
(or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
(and (not (eq (vla-get-objectid x) (vla-get-objectid #Curve)))
(setq #Int1 (vla-intersectwith x #Curve acextendthisentity))
(setq #Int2 (vlax-safearray->list (vlax-variant-value #Int1)))
(eq 3 (length #Int2))
(setq #Pnt (car (vl-sort (list (vlax-curve-getstartpoint x) (vlax-curve-getendpoint x))
'(lambda (a b) (< (distance a #Int2) (distance b #Int2)))
) ;_ vl-sort
) ;_ car
) ;_ setq
(vla-move x (vlax-3d-point #Pnt) #Int1)
) ;_ and
) ;_ vlax-for
(vla-delete #SS)
)
) ;_ cond
(princ)
) ;_ defun
非常好，谢谢你，艾伦。
我学到了更多。。。（我有很多东西要学）
谢谢你的时间。
帕斯卡
不客气。我很好奇我是否能做到。学习编码为我节省了很多时间和头痛眨眼： 非常好，非常感谢 功能稍好一些。。。
(defun c:MLTC (/ ss obj int)
;; Move Lines to Curve
;; Required Subroutines: AT:GetSel
;; Alan J. Thompson, 03.16.10 / 08.02.10
(vl-load-com)
(if (and (princ "\nSelect line object(s) to move: ")
(setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
(AT:GetSel entsel
"\nSelect curve to move line(s) to: "
(lambda (x)
(if (wcmatch (cdr (assoc 0 (entget (car x)))) "ARC,LINE,*POLYLINE,SPLINE")
(setq obj (vlax-ename->vla-object (car x)))
)
)
)
)
((lambda (id)
(vlax-for x (setq
ss (vla-get-activeselectionset
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
)
(if (and (/= id (vla-get-objectid x))
(eq 3 (length (setq int (vlax-invoke x 'IntersectWith obj acExtendThisEntity))))
)
(vl-catch-all-apply
(function vla-move)
(list x
(vlax-3d-point
(car (vl-sort (list (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint x))
(function (lambda (a b) (< (distance a int) (distance b int))))
)
)
)
(vlax-3d-point int)
)
)
)
)
(vla-delete ss)
)
(vla-get-objectid obj)
)
)
(princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(setvar 'errno 0)
(while (not good)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond
((vl-consp ent)
(setq good (if (or (not fnc) (fnc ent))
ent
(prompt "\nInvalid object!")
)
)
)
((eq (type ent) 'STR) (setq good ent))
((setq good (eq 52 (getvar 'errno))) nil)
((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
)
)
)
页:
[1]