如何批量剪切过圆或矩形的线；只剪圆和矩形内的线

tc405003 · 发表于 2005-9-24 14:33

alin · 发表于 2005-9-24 15:38

你这里的线只是指直线(Line)吗?

tc405003 · 发表于 2005-9-24 16:02

想LINE和PLINE都可

HuaiYu · 发表于 2005-10-9 14:22

本帖最后由作者于 2005-10-13 21:42:17 编辑

我想编一个局部放大的程序，跟这个也是有关系的，思路应该是一样的。

这是一个剪内圆的程式，请大家指教!

(defun c:t1 (/ loop en ss i sn snType)
(princ "\nPlease select a Circle:")
(vl-load-com)
(setq *AcadDocument* (vla-Get-ActiveDocument (vlax-get-acad-object)))
(setq loop t)
(while (not (setq en (ssget ":s" '((0 . "circle"))))) (princ "\nPlease select a circle"))
(setq en (ssname en 0))
(vla-StartUndoMark *AcadDocument*)
(vla-GetBoundingBox (vlax-ename->vla-object en) 'MinPt 'MaxPt)
(setq ss (ssget "_c" (vlax-safearray->list MaxPt) (vlax-safearray->list MinPt)))
(setq i 0)
(repeat (sslength ss)
    (setq sn (ssname ss i))
    (setq snType (vla-Get-ObjectName (vlax-ename->vla-object sn)))
    (if (not (member snType '("AcDbBlock" "AcDbText" "AcDbMText" "AcDbDimension" "AcDbXline" "AcDbRay")))
      (trim sn en)
    )
    (setq i (1+ i))
)
(vla-EndUndoMark *AcadDocument*)
(prin1)
)
(defun trim (sn en / vs vn pts Err lstParam pts lstPt)
(setq vs (vlax-ename->vla-object sn)
vn (vlax-ename->vla-object en)
)
(setq pts (vla-intersectwith vn vs acExtendNone))
(setq Err (vl-catch-all-apply 'vlax-safearray->list (list (vlax-variant-value pts))))
(if (not (vl-catch-all-error-p Err)) ;安璝Τ岿⊿Τユ翴玥ぃ暗安璝Τユ翴玥trim奔;
    (progn
;;;      (alert "InterSectWith")
      (setq lstParam '()
     lstParam (append lstParam (list (vlax-curve-getStartParam vs)))
     lstParam (append lstParam (list (vlax-curve-getEndParam vs)))
      )
      (setq pts      (vlax-safearray->list (vlax-variant-value pts))
     lstParam (GetParams pts lstParam vs)
     lstParam (vl-sort lstParam '<)
      )
      (setq lstPt (GetPtFromParam lstParam vs))
      (foreach pt lstPt
(if (< (distance pt (vlax-safearray->list (vlax-variant-value (vla-get-center vn))))
        (vla-Get-Radius vn)
     )
   (command ".trim" en "" pt "")
)
      )
    )
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetParams (pts lstParam vs / num i pt)
(setq num (/ (length pts) 3)
i   0
)
(repeat num
    (setq pt    (list (nth (+ i 0) pts) (nth (+ i 1) pts) (nth (+ i 2) pts))
   lstParam (append lstParam (list (vlax-curve-getParamAtPoint vs pt)))
   i    (+ i 3)
    )
)
lstParam
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetPtFromParam (lstParam vs / lst i num p1 p2 pm)
(setq lst '()
i   0
num (1- (length lstParam))
)
(repeat num
    (setq p1 (nth i lstParam)
   p2 (nth (1+ i) lstParam)
   pm (/ (+ p1 p2) 2)
   pt (vlax-curve-GetPointAtParam vs pm)
   lst (append lst (list pt))
   i   (1+ i)
    )
)
lst
)

zhongguola · 发表于 2005-10-9 15:21

多往后看几页帖子吧,我以前见过类似的帖子,里面有解决的程序.

ll_j · 发表于 2005-10-12 07:39

tc405003发表于2005-9-24 14:33:00回复：（tc405003）如何批量剪切过圆或矩形的线；只剪圆和矩形内的线如何批量剪切过圆或矩形的线；只剪圆和矩形内的线

可以研究一下ET的命令：extrim

dkj0322 · 发表于 2010-10-11 18:37

谢谢楼上的分享，参考下，很感激

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