请教如何以图块最外层的边界修剪图块下面的直线？

xyxy · 发表于 2011-11-30 19:26:52

本帖最后由 xyxy 于 2011-12-1 09:08 编辑

如题。
一条直线上有一个或多个图块，如何框选图块以图块的最外层边界线修剪此直线？
谢谢！
示意如下。

jkop · 发表于 2023-6-28 18:32:50

3、4、11楼的程序内容都很实用，虽然有功能重叠，都能做为学习的依据，感谢分享。

xyxy · 发表于 2011-12-1 09:07:03

有没有哪位高手能帮解决一下？非常感谢！

xiaxiang · 发表于 2011-12-1 11:06:39

非自动

(defun C:trimblk (/ pt1 pt2 el et)
(command "undo" "be")
(setq os (getvar "osmode"))
(setvar "osmode" 32)
(setq pt1 (getpoint "\n选择块与直线第一个交点: "))
(setq pt2 (getpoint pt1 "\n选择块与直线第二个交点 "))
(command "circle" "2p" pt1 pt2 )
(redraw (setq el (entlast)) 2)
(while (setq et (getpoint "\n选择被剪切的直线 (回车结束):"))
(command "trim" el "" et "" )
);while
(command "erase" el "" )
(setvar "osmode" os)
(command "redraw")
(command "undo" "e")
)

xiaxiang · 发表于 2011-12-1 11:31:12

本帖最后由 xiaxiang 于 2011-12-1 11:31 编辑

这是一个打断的程序

(defun c:BLKTRIM ( / *error* trim-blk rotate-bbox sv-cmd
sv-osm acad-doc ss cnt)
(defun *error* (msg)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
)
(defun trim-blk (pts / ln-set ln-obj sp ep tmp int-lst ct)
(if(setq ln-set(ssget "cp" pts '((0 . "*LINE,ARC"))))
(progn
(setq pts(reverse(cons(car pts)(reverse pts))))
(repeat(setq ct(sslength ln-set))
(setq ln-obj (vlax-ename->vla-object
(ssname ln-set
(setq ct(1- ct))
)
)
sp (vlax-curve-getStartPoint ln-obj)
ep (vlax-curve-getEndPoint ln-obj)
tmp pts
int-lst '()
)
(while(>(length tmp)1)
(if(setq int(inters sp ep(car tmp)(cadr tmp)nil))
(if(inters sp int (car tmp)(cadr tmp))
(setq int-lst(cons int int-lst))
)
)
(setq tmp(cdr tmp))
)
(if(=(length int-lst)2)
(vl-cmdf "_.break"
(list
(vlax-vla-object->ename ln-obj)
(car int-lst)
)
(cadr int-lst)
)
)
)
)
)
)
(defun rotate-bbox (blk-obj / mspace blk-rot blk-pt blk-bbox
p1 p2 p3 p4 x tmp)
(setq mspace (vla-get-modelspace acad-doc)
blk-rot (vlax-get-property blk-obj 'Rotation)
blk-pt (vlax-get-property blk-obj 'InsertionPoint)
)
(vlax-put-property blk-obj 'Rotation 0.0)
(setq blk-bbox (vla-getBoundingBox blk-obj 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p1 (list(car p1)(cadr p1))
p3 (list(car p3)(cadr p3))
p2 (list(car p1)(cadr p3))
p4 (list(car p3)(cadr p1))
)
(vlax-put-property blk-obj 'Rotation blk-rot)
(foreach x '(p1 p2 p3 p4)
(vla-rotate
(vla-addpoint mspace(vlax-3d-point(eval x)))
blk-pt
blk-rot
)
(set x(vlax-ename->vla-object(entlast)))
)
(foreach x '(p1 p2 p3 p4)
(setq tmp(eval x))
(set x
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property(eval x)'Coordinates)
)
)
)
(vla-delete tmp)
)
(list p1 p2 p3 p4)
)
(setq sv-cmd (getvar "cmdecho")
sv-osm (getvar "osmode")
acad-doc (vla-get-activedocument
(vlax-get-Acad-Object)
)
)
(setvar 'cmdecho 0)
(setvar 'osmode 0)
(vla-StartUndoMark acad-doc)
(if(setq ss(ssget '((0 . "INSERT"))))
(repeat(setq cnt(sslength ss))
(trim-blk
(rotate-bbox
(vlax-ename->vla-object
(ssname ss
(setq cnt(1- cnt))
)
)
)
)
)
)
(vla-EndUndoMark acad-doc)
(setvar 'cmdecho sv-cmd)
(setvar 'osmode sv-osm)
(princ)
)

(defun c:BLKTRIM ( / *error* trim-blk rotate-bbox sv-cmd 
                                sv-osm acad-doc ss cnt) 
 (defun *error* (msg) 
  (vla-EndUndoMark acad-doc) 
  (setvar 'cmdecho sv-cmd) 
  (setvar 'osmode sv-osm) 
 ) 
 
 (defun trim-blk (pts / ln-set ln-obj sp ep tmp int-lst ct) 
  (if(setq ln-set(ssget "cp" pts '((0 . "*LINE,ARC")))) 
   (progn 
    (setq pts(reverse(cons(car pts)(reverse pts)))) 
    (repeat(setq ct(sslength ln-set)) 
     (setq ln-obj  (vlax-ename->vla-object 
                    (ssname ln-set 
                      (setq ct(1- ct)) 
                    ) 
                   ) 
           sp      (vlax-curve-getStartPoint ln-obj) 
           ep      (vlax-curve-getEndPoint ln-obj) 
           tmp      pts 
           int-lst '() 
     ) 
     (while(>(length tmp)1) 
      (if(setq int(inters sp ep(car tmp)(cadr tmp)nil)) 
       (if(inters sp int (car tmp)(cadr tmp)) 
        (setq int-lst(cons int int-lst)) 
       ) 
      ) 
      (setq tmp(cdr tmp)) 
     ) 
     (if(=(length int-lst)2) 
      (vl-cmdf "_.break" 
               (list 
                (vlax-vla-object->ename ln-obj) 
                (car int-lst) 
               ) 
               (cadr int-lst) 
      ) 
     ) 
    ) 
   ) 
  ) 
 ) 
 
 (defun rotate-bbox (blk-obj / mspace blk-rot blk-pt blk-bbox 
                                            p1 p2 p3 p4 x tmp) 
 
  (setq mspace   (vla-get-modelspace acad-doc) 
        blk-rot  (vlax-get-property blk-obj 'Rotation) 
        blk-pt   (vlax-get-property blk-obj 'InsertionPoint) 
  ) 
  (vlax-put-property blk-obj 'Rotation 0.0) 
  (setq blk-bbox (vla-getBoundingBox blk-obj 'p1 'p3) 
        p1       (vlax-safearray->list p1) 
        p3       (vlax-safearray->list p3) 
        p1       (list(car p1)(cadr p1)) 
        p3       (list(car p3)(cadr p3)) 
        p2       (list(car p1)(cadr p3)) 
        p4       (list(car p3)(cadr p1)) 
  ) 
  (vlax-put-property blk-obj 'Rotation blk-rot) 
  (foreach x '(p1 p2 p3 p4) 
   (vla-rotate 
    (vla-addpoint mspace(vlax-3d-point(eval x))) 
     blk-pt 
     blk-rot 
   ) 
   (set x(vlax-ename->vla-object(entlast))) 
  ) 
  (foreach x '(p1 p2 p3 p4) 
   (setq tmp(eval x)) 
   (set x 
    (vlax-safearray->list 
     (vlax-variant-value 
      (vlax-get-property(eval x)'Coordinates) 
     ) 
    ) 
   ) 
   (vla-delete tmp) 
  ) 
  (list p1 p2 p3 p4) 
 ) 
 
 (setq sv-cmd   (getvar "cmdecho") 
       sv-osm   (getvar "osmode") 
       acad-doc (vla-get-activedocument 
                 (vlax-get-Acad-Object) 
                ) 
 ) 
 (setvar 'cmdecho 0) 
 (setvar 'osmode 0) 
 (vla-StartUndoMark acad-doc) 
 (if(setq ss(ssget '((0 . "INSERT")))) 
  (repeat(setq cnt(sslength ss)) 
   (trim-blk 
    (rotate-bbox 
     (vlax-ename->vla-object 
      (ssname ss 
       (setq cnt(1- cnt)) 
      ) 
     ) 
    ) 
   ) 
  ) 
 ) 
 (vla-EndUndoMark acad-doc) 
 (setvar 'cmdecho sv-cmd) 
 (setvar 'osmode sv-osm) 
 (princ) 
)

xyxy · 发表于 2011-12-1 11:33:07

本帖最后由 xyxy 于 2011-12-1 11:44 编辑

xiaxiang大侠提供的4#程序能满足我的要求，再次感谢热心的xiaxiang！

longer1000 · 发表于 2012-5-22 18:00:36

xyxy 发表于 2011-12-1 11:33
xiaxiang大侠提供的4#程序能满足我的要求，再次感谢热心的xiaxiang！

老兄，这个问题解决了？

xyxy · 发表于 2012-5-22 19:48:46

longer1000 发表于 2012-5-22 18:00
老兄，这个问题解决了？

longer1000兄，xiaxiang大侠提供的程序已经能满足我所需的要求，谢谢关注！

longer1000 · 发表于 2012-5-23 08:38:58

xyxy 发表于 2012-5-22 19:48
longer1000兄，xiaxiang大侠提供的程序已经能满足我所需的要求，谢谢关注！

能否分享下，或者发邮箱longer1000@sina.com，谢谢

xyxy · 发表于 2012-5-23 17:28:52

longer1000兄，xiaxiang大侠提供的程序就在3楼和4楼，复制即可使用。

半听可乐 · 发表于 2013-1-1 21:41:03

xiaxiang 发表于 2011-12-1 11:31
这是一个打断的程序

非常实用的程序！如果能把图示小bug完善一下就更好了！

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

请教如何以图块最外层的边界修剪图块下面的直线？

本帖子中包含更多资源

相关帖子

评分

点评

本帖子中包含更多资源