口齿不清问题，请用l
嗨，伙计们可以帮我补充一下“dot”功能吗？谢谢！
;;http://bbs.xdcad.org/thread-678248-1-1.html
;;by huang
(defun C:myjoin(/ E H J LST N OBJ P11 P12 P21 P22 SS X)
(defun twoEnt (e1 e2)
(setq p11 (vlax-curve-getStartPoint e1))
(setq p12 (vlax-curve-getEndPoint e1))
(setq p21 (vlax-curve-getStartPoint e2))
(setq p22 (vlax-curve-getEndPoint e2))
(cond ((and (equal (det p11 p12 p21) 0) (equal (det p11 p12 p22) 0))
(setq H (car (Max-distance (list p11 p12 p21 p22))))
(setq obj (vlax-ename->vla-object e1))
(vlax-put obj 'StartPoint (car H))
(vlax-put obj 'EndPoint (cadr H))
)
)
)
(cond
((setq ss (ssget '((0 . "LINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lst (cons e lst))
)
(foreach j lst
(mapcar '(lambda (x) (cond ((and (entget x) (entget j)) (twoEnt j x)))) lst)
)
)
)
(princ)
)
;;(Max-distance (getpt (ssget) 10))=>(((-2670.87 3701.22 0.0) (-1725.61 3689.13 0.0)) . 945.338)
(defun Max-distance (H / D M MAXD P PAIR Q U V W)
(setq Q (cdr (append H H (list (car H)))))
(setq MaxD 0.0)
(foreach U H
(setq V (car Q))
(setq W (cadr Q))
(setq M (MJ:Mid V W))
(while (> (dot M U V) 0.0)
(setq Q (cdr Q))
(setq V (car Q))
(setq W (cadr Q))
(setq M (MJ:Mid V W))
)
(setq D (distance U V))
(if (> D MaxD)
(setq MaxD D
Pair (list U V)
)
)
)
(cons Pair MaxD)
)
(defun MJ:Mid (P1 P2)
(mapcar '(lambda (X Y) (* (+ X Y) 0.5)) P1 P2)
)
;;(det (getpoint)(getpoint)(getpoint))
(defun det (p1 p2 p3 / x2 y2)
(setq x2 (car p2)
y2 (cadr p2)
)
(- (* (- x2 (car p3)) (- y2 (cadr p1)))
(* (- x2 (car p1)) (- y2 (cadr p3)))
)
)
代码有点错误。。。我不知道该怎么办，但我猜应该是这样的：
;;http://bbs.xdcad.org/thread-678248-1-1.html
;;by huang
;;mod by M.R.
(defun c:myjoin (/ e h j lst n obj p11 p12 p21 p22 ss)
(vl-load-com)
(defun twoent (e1 e2)
(setq p11 (vlax-curve-getstartpoint e1))
(setq p12 (vlax-curve-getendpoint e1))
(setq p21 (vlax-curve-getstartpoint e2))
(setq p22 (vlax-curve-getendpoint e2))
(if (and (equal (det p11 p12 p21) 0)
(equal (det p11 p12 p22) 0)
)
;=> if you want only WCS calculation leave this line, but if you want it 3D replace line with T
(progn
(setq h (car (max-distance (list p11 p12 p21 p22))))
(setq obj (vlax-ename->vla-object e1))
(vlax-put obj 'startpoint (car h))
(vlax-put obj 'endpoint (cadr h))
)
)
)
(cond
((setq ss (ssget '((0 . "LINE"))))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq lst (cons e lst))
)
(foreach j lst
(mapcar '(lambda (x)
(cond ((and (entget x) (entget j)) (twoent j x)))
)
lst
)
)
)
)
(princ)
)
;;(max-distance ptlst)=>(((-2670.87 3701.22 0.0) (-1725.61 3689.13 0.0)) . 945.338)
(defun max-distance (h / d maxd pair q v)
(setq q (cdr (append h h (list (car h)))))
(setq maxd 0.0)
(foreach u h
(setq
v (car
(vl-sort q
'(lambda (a b) (> (distance u a) (distance u b)))
)
)
)
(setq d (distance u v))
(if (> d maxd)
(setq maxd d
pair (list u v)
)
)
)
(cons pair maxd)
)
;;(det (getpoint)(getpoint)(getpoint))
(defun det (p1 p2 p3)
(+ (* (car p1)
(- (* (cadr p2) (caddr p3)) (* (cadr p3) (caddr p2)))
)
(* (- (cadr p1))
(- (* (car p2) (caddr p3)) (* (car p3) (caddr p2)))
)
(* (caddr p1)
(- (* (car p2) (cadr p3)) (* (car p3) (cadr p2)))
)
)
)
非常感谢你，马尔科。但是，无法批量加入。
应该是这样的：
(defun dot (p1 p2 p3 / x1 y1)
(setq x1 (car p1)
y1 (cadr p1)
)
(+ (* (- (car p2) x1) (- (car p3) x1))
(* (- (cadr p2) y1) (- (cadr p3) y1))
)
)
我找到了“点”函数，但不能正常工作 我建议您对同一任务使用JOIN命令。。。
http://www.theswamp.org/index.php?topic=46124.0
;Written by: Chris Wade
;small mod by M.R.
(defun c:ja ( / *error* uFlag doc StopLoop SelSet SelLen LoopCT )
(vl-load-com)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(defun *error* (msg)
(if doc
(vla-EndUndoMark doc)
)
(if msg
(prompt msg)
)
(princ)
)
(while (= StopLoop nil)
(princ
"\nPlease select the objects that you would like to join : "
)
(setq SelSet (ssget))
(cond ((/= SelSet nil)
(vla-StartUndoMark doc)
(setq SelLen (sslength SelSet))
(setq LoopCT 0)
(while (< LoopCT SelLen)
(vl-cmdf "._join" (ssname SelSet LoopCT) SelSet "")
(setq LoopCT (+ LoopCT 1))
)
(setq StopLoop T)
)
)
)
(*error* nil)
)
我以为你想要这样的东西：
;;by M.R.
(defun c:myjoin ( / max-distance e ptlst n p1 p2 ss filter ch x )
;;(max-distance ptlst)=>(((-2670.87 3701.22 0.0) (-1725.61 3689.13 0.0)) . 945.338)
(defun max-distance ( h / d maxd pair q v )
(setq q h)
(setq maxd 0.0)
(foreach u h
(setq
v (car
(vl-sort q
'(lambda ( a b ) (> (distance u a) (distance u b)))
)
)
)
(setq d (distance u v))
(if (> d maxd)
(setq maxd d
pair (list u v)
)
)
)
(cons pair maxd)
)
(initget "2D 3D")
(setq ch (getkword "\n2D or 3D calculation <3D> : "))
(if (null ch)
(setq ch "3D")
)
(setq filter (if (eq ch "3D")
(list '(0 . "LINE"))
(list '(0 . "LINE") '(-4 . "<and")
'(-4 . "*,*,=") '(10 0.0 0.0 0.0)
'(-4 . "*,*,=") '(11 0.0 0.0 0.0)
'(-4 . "and>")
)
)
)
(setq ss (ssget filter))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 11 (entget e)))
)
(setq ptlst (cons p1 ptlst)
ptlst (cons p2 ptlst)
)
)
(setq x (max-distance ptlst))
(entmake (list '(0 . "LINE")
(cons 10 (caar x))
(cons 11 (cadar x))
'(62 . 1)
)
)
(princ)
)
您好，M.R。
李的套路很好！！！
谢谢你，马尔科，这也很好！但如果能用普林，那就更完美了！！！
不，这不是我想要的。这无法批量合并行。
页:
[1]