求助个思路，就是直线没相交就延伸到那个位置，如果相交就剪切掉

Andyhon · 发表于 2012-3-20 11:56

Express Tools 所附
http://www.google.com/search?lr= ... A%2F%2Fbbs.mjtd.com

xiaxiang · 发表于 2012-3-20 13:26

本帖最后由 xiaxiang 于 2012-3-20 13:32 编辑

如下代码须全部一起选中，边界必须是复线

(defun c:mextend (/ ang c e lines lwp lyr ptlst pts ss)
(if (setq ss (ssget ":L" '((0 . "LWPOLYLINE,LINE,SPLINE,CIRCLE"))))
(progn
(mapcar '(lambda (e)
(if (wcmatch (cdr (assoc 0 (entget e))) "LINE")
(setq lines (cons e lines))
(setq lwp (cons e lwp))
)
)
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
(if (and lwp lines)
(foreach l (mapcar 'vlax-ename->vla-object lines)
(setq
ang (vla-get-angle l)
lyr (vla-get-layer l)
ptlst nil
)
(foreach pl (mapcar 'vlax-ename->vla-object lwp)
(setq c nil)
(if
(and (vlax-property-available-p pl 'closed) (zerop (vlax-get pl 'closed)) (setq c t))
(vlax-put pl 'closed -1)
)
(if (setq pts (vlax-invoke l 'intersectwith pl acextendthisentity))
(while pts
(setq ptlst (cons (list (car pts) (cadr pts)) ptlst))
(setq pts (cdddr pts))
)
)
(and c (vlax-put pl 'closed 0))
)
(if ptlst
(progn (setq ptlst (vl-sort ptlst
(function (lambda (d1 d2)
(if (equal ang 0.0 pi)
(> (car d1) (car d2))
(< (cadr d1) (cadr d2))
)
)
)
)
)
(while ptlst
(entmakex
(list '(0 . "LINE") (cons 8 lyr) (cons 10 (car ptlst)) (cons 11 (cadr ptlst)))
)
(setq ptlst (cddr ptlst))
)
(vla-delete l)
)
)
)
)
)
)
(princ)
)

(defun c:mextend (/ ang c e lines lwp lyr ptlst pts ss) 
  (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE,LINE,SPLINE,CIRCLE")))) 
    (progn 
      (mapcar '(lambda (e) 
(if (wcmatch (cdr (assoc 0 (entget e))) "LINE") 
   (setq lines (cons e lines)) 
   (setq lwp (cons e lwp)) 
) 
       ) 
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) 
      ) 
      (if (and lwp lines) 
(foreach l (mapcar 'vlax-ename->vla-object lines) 
  (setq 
ang   (vla-get-angle l) 
lyr   (vla-get-layer l) 
ptlst nil 
  ) 
  (foreach pl (mapcar 'vlax-ename->vla-object lwp) 
    (setq c nil) 
    (if 
      (and (vlax-property-available-p pl 'closed) (zerop (vlax-get pl 'closed)) (setq c t)) 
       (vlax-put pl 'closed -1) 
    ) 
    (if (setq pts (vlax-invoke l 'intersectwith pl acextendthisentity)) 
      (while pts 
(setq ptlst (cons (list (car pts) (cadr pts)) ptlst)) 
(setq pts (cdddr pts)) 
      ) 
    ) 
    (and c (vlax-put pl 'closed 0)) 
  ) 
  (if ptlst 
    (progn (setq ptlst (vl-sort ptlst 
(function (lambda (d1 d2) 
    (if (equal ang 0.0 pi) 
      (> (car d1) (car d2)) 
      (< (cadr d1) (cadr d2)) 
    ) 
  ) 
) 
       ) 
   ) 
   (while ptlst 
     (entmakex 
       (list '(0 . "LINE") (cons 8 lyr) (cons 10 (car ptlst)) (cons 11 (cadr ptlst))) 
     ) 
     (setq ptlst (cddr ptlst)) 
   ) 
   (vla-delete l) 
    ) 
  ) 
) 
      ) 
    ) 
  ) 
  (princ) 
)

xiaxiang · 发表于 2012-3-20 13:37

Here's another.
先选边界，再选对象

(defun c:extlines (/ bound int pt)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(if (and (setq bound (car (entsel "\n请选择边界: ")))
(setq bound (vlax-ename->vla-object bound))
)
(if (ssget '((0 . "LINE")))
(progn
(vla-StartUndoMark *acdoc*)
(vlax-for l (vla-get-ActiveSelectionSet *acdoc*)
(setq int (vlax-invoke bound 'IntersectWith l acExtendOtherEntity))
(while int
(setq pt (list (car int) (cadr int) (caddr int))
int (cdddr int)
)
(if (< (distance (vlax-get l 'StartPoint) pt)
(distance (vlax-get l 'EndPoint) pt)
)
(vlax-put l 'StartPoint pt)
(vlax-put l 'EndPoint pt)
)
)
)
(vla-EndUndoMark *acdoc*)
)
)
)
(princ)
)

daiguafan · 发表于 2012-3-20 13:59

xiaxiang 发表于 2012-3-20 13:37
Here's another.
先选边界，再选对象

这个是我最喜欢的一个，哈哈哈，谢谢

czb203 · 发表于 2012-3-21 09:45

非常牛逼的样子很喜欢啊谢谢

adc · 发表于 2012-3-24 19:24

看看这个怎样？

52幕墙设计 · 发表于 2013-4-19 01:11

非常感谢，这个很好

bai0379 · 发表于 2013-4-30 08:06

这个好用,支持一下

流动的清泉 · 发表于 2017-11-15 22:38

我想找一个标准的用剪切和延伸的命令，怎么都没有找到，因为两个线可能不共面，替换变量没有什么意义

coverne · 发表于 2017-12-4 20:11

学习下22 23 26的

账号		自动登录	找回密码
密码			注册

求助个思路，就是直线没相交就延伸到那个位置，如果相交就剪切掉

,,

本帖子中包含更多资源

浏览过的版块