BOUNDARY用弧岛的办法太卡了

taoyi0727

图中的效果怎么才能实现，不用BOUNDARY太卡了，这样做就算不是封闭区域也可以得到一个矩形

能写一个我学习下么？

Gu_xl

1. ;;动态框绘制 By 明经通道 Gu_xl
   
2. (defun c:DynRect (/               GR         GetScreenCoords
   
3.              LL               LMTS         LOOP           LU             P1
   
4.              P2               P3         P4           PT             RL
   
5.              RU               S1         S2           S3             S4
   
6.             )
   
7.   ;;取得当前绘图区屏幕的左下角和右上角的坐标
   
8.   (defun GetScreenCoords
   
9.          (/ c03 c08 c04 c05 c07 c06 c09 c01 c02)
   
10.     (setq c03 (getvar "viewctr")
    
11.           c03 (trans c03 1 2)
    
12.           c08 (getvar "viewsize")
    
13.           c04 (getvar "screensize")
    
14.           c07 (car c04)
    
15.           c06 (cadr c04)
    
16.           c09 (/ (* c08 c07) c06)
    
17.           c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
    
18.           c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))
    
19.           c01 (trans c01 2 1)
    
20.           c02 (trans c02 2 1)
    
21.     )
    
22.     (list c01 c02)
    
23.   )
    
24.   (setq loop t)
    
25.   (while loop
    
26.     (setq lmts (GetScreenCoords))
    
27.     (setq gr (grread t 15 0))
    
28.     (cond ((= 5 (car gr))
    
29.            (setq pt (cadr gr))
    
30.            (if (and
    
31.                  (setq s1 (ssget "F"
    
32.                                  (list pt (list (car pt) (cadadr lmts) 0))
    
33.                                  '((0 . "*line,arc,circle"))
    
34.                           )
    
35.                  ) ;_ 向上
    
36.                  (setq s2 (ssget "F"
    
37.                                  (list pt (list (car pt) (cadar lmts) 0))
    
38.                                  '((0 . "*line,arc,circle"))
    
39.                           )
    
40.                  ) ;_ 向下
    
41.                  (setq s3 (ssget "F"
    
42.                                  (list pt (list (caar lmts) (cadr pt) 0))
    
43.                                  '((0 . "*line,arc,circle"))
    
44.                           )
    
45.                  ) ;_ 向左
    
46.                  (setq s4 (ssget "F"
    
47.                                  (list pt (list (caadr lmts) (cadr pt) 0))
    
48.                                  '((0 . "*line,arc,circle"))
    
49.                           )
    
50.                  ) ;_ 向右
    
51.                )
    
52.              (progn
    
53.                (setq p1 (trans (cadar (cdddar (ssnamex s1))) 0 1)) ;_ 上点
    
54.                (setq p2 (trans (cadar (cdddar (ssnamex s2))) 0 1)) ;_ 下点
    
55.                (setq p3 (trans (cadar (cdddar (ssnamex s3))) 0 1)) ;_ 左点
    
56.                (setq p4 (trans (cadar (cdddar (ssnamex s4))) 0 1)) ;_ 右点
    
57.                (setq ll (apply 'mapcar (cons 'min (list p1 p2 p3 p4)))) ;_ 左下角点
    
58.                (setq ru (apply 'mapcar (cons 'max (list p1 p2 p3 p4)))) ;_ 右上角点
    
59.                (setq lu (list (car ll) (cadr ru) 0)) ;_ 左上角点
    
60.                (setq rl (list (car ru) (cadr ll) 0)) ;_ 右下角点
    
61.                (redraw)
    
62.                (grdraw ll lu 1)
    
63.                (grdraw lu ru 1)
    
64.                (grdraw ru rl 1)
    
65.                (grdraw rl ll 1)
    
66.              )
    
67.              (redraw)
    
68.            )
    
69.           )
    
70.           ((= 3 (car gr))
    
71.            (setq loop nil)
    
72.            (command "_rectang" "_non" ll "_non" ru)
    
73.           )
    
74.     )
    
75.   )
    
76.   (redraw)
    
77.   (princ)
    
78. )

;;动态框绘制 By 明经通道 Gu_xl <br /> (defun c:DynRect (/               GR         GetScreenCoords<br />              LL               LMTS         LOOP           LU             P1<br />              P2               P3         P4           PT             RL<br />              RU               S1         S2           S3             S4<br />             )<br />   ;;取得当前绘图区屏幕的左下角和右上角的坐标<br />   (defun GetScreenCoords<br />          (/ c03 c08 c04 c05 c07 c06 c09 c01 c02)<br />     (setq c03 (getvar "viewctr")<br />           c03 (trans c03 1 2)<br />           c08 (getvar "viewsize")<br />           c04 (getvar "screensize")<br />           c07 (car c04)<br />           c06 (cadr c04)<br />           c09 (/ (* c08 c07) c06)<br />           c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))<br />           c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))<br />           c01 (trans c01 2 1)<br />           c02 (trans c02 2 1)<br />     )<br />     (list c01 c02)<br />   )<br />   (setq loop t)<br />   (while loop<br />     (setq lmts (GetScreenCoords))<br />     (setq gr (grread t 15 0))<br />     (cond ((= 5 (car gr))<br />            (setq pt (cadr gr))<br />            (if (and<br />                  (setq s1 (ssget "F"<br />                                  (list pt (list (car pt) (cadadr lmts) 0))<br />                                  '((0 . "*line,arc,circle"))<br />                           )<br />                  ) ;_ 向上<br />                  (setq s2 (ssget "F"<br />                                  (list pt (list (car pt) (cadar lmts) 0))<br />                                  '((0 . "*line,arc,circle"))<br />                           )<br />                  ) ;_ 向下<br />                  (setq s3 (ssget "F"<br />                                  (list pt (list (caar lmts) (cadr pt) 0))<br />                                  '((0 . "*line,arc,circle"))<br />                           )<br />                  ) ;_ 向左<br />                  (setq s4 (ssget "F"<br />                                  (list pt (list (caadr lmts) (cadr pt) 0))<br />                                  '((0 . "*line,arc,circle"))<br />                           )<br />                  ) ;_ 向右<br />                )<br />              (progn<br />                (setq p1 (trans (cadar (cdddar (ssnamex s1))) 0 1)) ;_ 上点<br />                (setq p2 (trans (cadar (cdddar (ssnamex s2))) 0 1)) ;_ 下点<br />                (setq p3 (trans (cadar (cdddar (ssnamex s3))) 0 1)) ;_ 左点<br />                (setq p4 (trans (cadar (cdddar (ssnamex s4))) 0 1)) ;_ 右点<br />                (setq ll (apply 'mapcar (cons 'min (list p1 p2 p3 p4)))) ;_ 左下角点<br />                (setq ru (apply 'mapcar (cons 'max (list p1 p2 p3 p4)))) ;_ 右上角点<br />                (setq lu (list (car ll) (cadr ru) 0)) ;_ 左上角点<br />                (setq rl (list (car ru) (cadr ll) 0)) ;_ 右下角点<br />                (redraw)<br />                (grdraw ll lu 1)<br />                (grdraw lu ru 1)<br />                (grdraw ru rl 1)<br />                (grdraw rl ll 1)<br />              )<br />              (redraw)<br />            )<br />           )<br />           ((= 3 (car gr))<br />            (setq loop nil)<br />            (command "_rectang" "_non" ll "_non" ru)<br />           )<br />     )<br />   )<br />   (redraw)<br />   (princ)<br /> )

飞鱼StrawHaat

taoyi0727 发表于 2018-6-14 16:28
用这个方法  还是比用BOUNDARY弧岛的办法  快很多
思路是看的海龙工具里的，主要函数来自明经，我就是个DI ...

上面G版的回复接近于完美答案了，我上传的附件作用仅仅在于精简了你原来的代码而已，不值一哂。
ssget构建的选择集中图元的顺序和图元对象被拾取、选择的顺序相关，因此，不管是栏选(F)还是窗交(C),只要选择的顺序是从光标处至视图边框，该选择集中的第一个图元就是选择集所有图元中距光标最近的，所以，如果通过求交点的方法，只需要求得该图元和光标处直线的交点即可，没必要求得所有交点再进行比较。

---

taoyi0727

自己琢磨出来了 但是不会高级函数，都是一般的函数堆出来的，代码好长，大神们都帮我改改吗？
有一个函数是

自贡黄明儒

的 HH:TwoEntsInters 两对象交点列表
有一个函数不知道是谁的了 fp 屏幕两对角坐标




大神们都帮我改改

飞鱼StrawHaat

评分的评论有字数限制，lisp动态处理的思路建议你去 Lee Mac 的个人网站 http://www.lee-mac.com 学习

飞鱼StrawHaat

明经币每次只能送一个，给你送10次吧。

taoyi0727

飞鱼StrawHaat 发表于 2018-6-14 13:11
明经币每次只能送一个，给你送10次吧。

主要是英文不会 就只认识字母 看那些英文网站有难度
我后面又修改了下  不会出现错误
但是新的问题又来了  用这种方法只能找到Z轴在0上的交点 有好多图Z轴不是在0上，只是无限接近z轴0位，每次打开文件都先全图Z轴归0的话，这个程序就不通用了
有没有投影找交点的办法，或着好点的思路

taoyi0727

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=79868

8楼的代码可以解决这个问题
他的方法是复制出1个一个的实体，把这个实体Z归0，再求交点，然后删除实体

刚试了下  问题又绕回来了 用这个图多在卡爆了

taoyi0727

用这个方法  还是比用BOUNDARY弧岛的办法  快很多
思路是看的海龙工具里的，主要函数来自明经，我就是个DIY小能手
谢谢 飞鱼StrawHaat 的支持
不知道为什么我发的贴没什么人理，哎~，没难度？还是太难？可能是太忙
有大神给优化一下就好了

taoyi0727

Gu_xl 发表于 2018-6-15 16:33

谢G版的回复，明明用ssget里有选arc,有的arc就找不到点

taoyi0727

找到原因了
把    '((0 . "*line,arc.circle"))
改成'((0 . "*line,arc,circle"))