移动线，对齐边缘
尊敬的masters Autolisp：我们需要帮助我。我需要一个例程，允许移动选定的线，使其边缘与特定的对齐基础对齐。它将类似于扩展/围栏功能，但仅具有移动的结果。不应更改要移动的线的长度。
应该有一个选项将给定的对齐方式与左、右、顶部和底部对齐。
如果可以选择对齐基准的角度，它将更加通用，但就目前而言，仅对我而言，移动是垂直于对齐的。
我附上一张图片，以便更好地理解其意图。
从这里开始。
我在为OP写一个伪代码，显然他知道如何写代码。但我想你发布的链接可能会更有帮助。
干杯，李 【YodaVoice】
... 我感觉到原力的扰动。
lee mac上的新“动态实体对齐”功能。我们必须创造com。
http://1.bp.blogspot.com/-ra4fDY1vjPQ/TaO4TfkO5RI/AAAAAAAAAaY/kGy8GfapQyc/s1600/25917_yoda.jpg
林奇 我对AutoLISP的了解是基本的。谢谢你的链接，我已经知道了。
如果没有你的帮助，两年后就可以发展。 我发誓我在大约1-2年前为这里的某个人做了这件事。 作者：Alan J.Thompson
(defun c:MLTC2 (/ 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.")))
)
)
) 轻微调整。。。（如果你找到了我发布的地方，你应该发布链接，而不是代码）
(defun c:MCTC (/ _1st AT:GetSel ss obj int)
(vl-load-com)
(defun _1st (lst)
(if lst
(list (car lst) (cadr lst) (caddr lst))
)
)
(defun AT:GetSel (meth msg fnc / ent)
;; 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
(progn (setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)
(princ "\nSelect curve object(s) to move: ")
(if (and (setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
(AT:GetSel entsel
"\nSelect curve to move selected curve(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 (/= (vla-get-objectid x) id)
(setq int (_1st (vlax-invoke x 'IntersectWith obj acExtendThisEntity)))
)
(vla-move 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)
) 写这篇文章很有趣：
;; Example program by Lee Mac 2011-www.lee-mac.com
(defun c:MoveLines2Line ( / en in ip p1 p2 p3 p4 ss )
(if
(and
(princ "\nSelect Line to Move Lines to...")
(setq en (ssget "_+.:E:S" '((0 . "LINE"))))
(princ "\nSelect Lines to Move...")
(setq ss (ssget "_:L" '((0 . "LINE"))))
)
(progn
(setq en (entget (ssname en 0))
p1 (cdr (assoc 10 en))
p2 (cdr (assoc 11 en))
)
(repeat (setq in (sslength ss))
(setq en (entget (ssname ss (setq in (1- in))))
p3 (cdr (assoc 10 en))
p4 (cdr (assoc 11 en))
)
(if (setq ip (inters p1 p2 p3 p4 nil))
(entmod
(cons (assoc -1 en)
(if (< (distance ip p4) (distance ip p3))
(list
(cons 11 ip)
(cons 10 (mapcar '+ ip (mapcar '- p3 p4)))
)
(list
(cons 10 ip)
(cons 11 (mapcar '+ ip (mapcar '- p4 p3)))
)
)
)
)
)
)
)
)
(princ)
) 我平庸的尝试：
(defun c:LinesTo ( / M o v e to edge)
(defun _errorMsg(lst / NilVal)
(while (eval (setq NilVal (car (car lst))))
(setq lst (cdr lst)))
(if lst
(alert (cadr (assoc NilVal lst))))
)
(prompt "\nSelect objects to move: ")
(cond ((and
(setq M (ssget ":L" '((0 . "LINE"))))
(setq o (car (entsel "\nSelect Edge: ")))
(setq o (vlax-ename->vla-object o))
(repeat (sslength M)
(setq v (ssname M 0))
(setq edge (mapcar 'cdr (vl-remove-if-not '(lambda (y)
(member (car y) '(10 11))) (entget v))))
(setq e (vlax-invoke (vlax-ename->vla-object v) 'IntersectWitho acExtendThisEntity))
(if e (progn
(if (> (distance e (cadr edge))
(distance e (car edge)))
(setq to (car edge))
(setq to (cadr edge))
)
(vla-move (vlax-ename->vla-object v)
(vlax-3d-point to)(vlax-3d-point e))
)
(progn
(princ "\rNo Intersection Found for ")(prin1 ent) ))
(ssdel v M))
)
)
)
(_errorMsg
(list '(m "Failed to select Object")
'(o "Edge Not Found")
))
(princ)
)
页:
[1]
2