自己写了个插件，失灵时不灵。求助大佬给指点一下哪里有问题

raimo

我写了一个小插件工作用的。就是通过选择上下左右四个最边界的位置，自动绘制一个四边出头的线框，但
代码不稳定，老是错误输出。求助大佬给指点一下哪里有问题

2. (defun c:ctx()
   
3. (setq oldcolor (getvar "cecolor"))
   
4. (setq sb (getvar "blipmode"))
   
5. (setq temp (getvar "osmode"))
   
6. (setvar "cecolor" "8")
   
7. (setvar "blipmode" 0)
   
8. (setvar "osmode" 16383)
   
9. (setvar "cmdecho" 0)
   
10. 
    
11. ;;根据全局比例设置出头线段长度，即 50比例的 6倍为长度 300
    
12. (setq aa(getvar "dimscale"))
    
13. (setq CTLenth (* aa 6))
    
14. ;调试显示长度值
    
15. (print CTLenth)
    
16. 
    
17. ;;根据选择，确认图纸的边界范围，左下x1y1 右上x2y2
    
18. (setq ptleft (getpoint "\n选择最左点:"))
    
19. (set 'x1 (car ptleft))
    
20. (print x1)
    
21. 
    
22. (setq ptright (getpoint "\n选择最右点:"))
    
23. (set 'x2 (car ptright))
    
24. (print x2)
    
25. 
    
26. (setq ptbottom (getpoint "\n选择最底点:"))
    
27. (set 'y1 (cadr ptbottom))
    
28. (print y1)
    
29. 
    
30. (setq pttop (getpoint "\n选择最顶点:"))
    
31. (set 'y2 (cadr pttop))
    
32. (print y2)
    
33. 
    
34. (COMMAND "LINE" (list (- x1 CTLenth) y1) (list (+ x2 CTLenth) y1) "")
    
35. (COMMAND "LINE" (list (- x1 CTLenth) y2) (list (+ x2 CTLenth) y2) "")
    
36. (COMMAND "LINE" (list x1 (- y1 CTLenth)) (list x1 (+ y2 CTLenth)) "")
    
37. (COMMAND "LINE" (list x2 (- y1 CTLenth)) (list x2 (+ y2 CTLenth)) "")
    
38. 
    
39. (setvar "cecolor" oldcolor)
    
40. (setvar "blipmode" sb)
    
41. (setvar "osmode" temp)
    
42. (setvar "cmdecho" 1)
    
43. (princ)
    
44. )

(defun c:ctx()<br /> (setq oldcolor (getvar "cecolor"))<br /> (setq sb (getvar "blipmode"))<br /> (setq temp (getvar "osmode"))<br /> (setvar "cecolor" "8")<br /> (setvar "blipmode" 0)<br /> (setvar "osmode" 16383)<br /> (setvar "cmdecho" 0)<br /> <br /> ;;根据全局比例设置出头线段长度，即 50比例的 6倍为长度 300<br /> (setq aa(getvar "dimscale"))<br /> (setq CTLenth (* aa 6))<br /> ;调试显示长度值<br /> (print CTLenth)<br /> <br /> ;;根据选择，确认图纸的边界范围，左下x1y1 右上x2y2<br /> (setq ptleft (getpoint "\n选择最左点:"))<br /> (set 'x1 (car ptleft))<br /> (print x1)<br /> <br /> (setq ptright (getpoint "\n选择最右点:"))<br /> (set 'x2 (car ptright))<br /> (print x2)<br /> <br /> (setq ptbottom (getpoint "\n选择最底点:"))<br /> (set 'y1 (cadr ptbottom))<br /> (print y1)<br /> <br /> (setq pttop (getpoint "\n选择最顶点:"))<br /> (set 'y2 (cadr pttop))<br /> (print y2)<br /> <br /> (COMMAND "LINE" (list (- x1 CTLenth) y1) (list (+ x2 CTLenth) y1) "")<br /> (COMMAND "LINE" (list (- x1 CTLenth) y2) (list (+ x2 CTLenth) y2) "")<br /> (COMMAND "LINE" (list x1 (- y1 CTLenth)) (list x1 (+ y2 CTLenth)) "")<br /> (COMMAND "LINE" (list x2 (- y1 CTLenth)) (list x2 (+ y2 CTLenth)) "")<br /> <br /> (setvar "cecolor" oldcolor) <br /> (setvar "blipmode" sb)<br /> (setvar "osmode" temp)<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )

想要达到的效果如下图。


自己检查和改动很多次了。就是不知道为什么失灵时不灵。是否参数定义上有问题？


附上测试文件， 反正就是不能稳定保证线段能正常出头。

飞雪神光

用command 绘图要关闭捕捉 你却都打开 要是改为包围盒只需要框选一下就可以 不用指定四点

1. (defun c:ctx(/ aa ctlenth ptbottom ptleft ptright pttop sb x1 x2 y1 y2)
   
2.   (setq sb (getvar "blipmode"))
   
3.   (setvar "blipmode" 0)
   
4.   (setvar "cmdecho" 0)
   
5.   
   
6.   ;;根据全局比例设置出头线段长度，即 50比例的 6倍为长度 300
   
7.   (setq aa(getvar "dimscale"))
   
8.   (setq CTLenth (* aa 6))
   
9.   ;调试显示长度值
   
10.   (print CTLenth)
    
11.   
    
12.   ;;根据选择，确认图纸的边界范围，左下x1y1 右上x2y2
    
13.   (setq ptleft (getpoint "\n选择最左点:"))
    
14.   (setq x1 (car ptleft))
    
15.   (print x1)
    
16.   
    
17.   (setq ptright (getpoint "\n选择最右点:"))
    
18.   (setq x2 (car ptright))
    
19.   (print x2)
    
20.   
    
21.   (setq ptbottom (getpoint "\n选择最底点:"))
    
22.   (setq y1 (cadr ptbottom))
    
23.   (print y1)
    
24.   
    
25.   (setq pttop (getpoint "\n选择最顶点:"))
    
26.   (setq y2 (cadr pttop))
    
27.   (print y2)
    
28.   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list (- x1 CTLenth) y1))(cons 11 (list (+ x2 CTLenth) y1))))
    
29.   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list (- x1 CTLenth) y2))(cons 11 (list (+ x2 CTLenth) y2))))
    
30.   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list x1 (- y1 CTLenth)))(cons 11 (list x1 (+ y2 CTLenth)))))
    
31.   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list x2 (- y1 CTLenth)))(cons 11 (list x2 (+ y2 CTLenth)))))
    
32.   (setvar "blipmode" sb)
    
33.   (princ)
    
34. )

(defun c:ctx(/ aa ctlenth ptbottom ptleft ptright pttop sb x1 x2 y1 y2)<br />   (setq sb (getvar "blipmode"))<br />   (setvar "blipmode" 0)<br />   (setvar "cmdecho" 0)<br />   <br />   ;;根据全局比例设置出头线段长度，即 50比例的 6倍为长度 300<br />   (setq aa(getvar "dimscale"))<br />   (setq CTLenth (* aa 6))<br />   ;调试显示长度值<br />   (print CTLenth)<br />   <br />   ;;根据选择，确认图纸的边界范围，左下x1y1 右上x2y2<br />   (setq ptleft (getpoint "\n选择最左点:"))<br />   (setq x1 (car ptleft))<br />   (print x1)<br />   <br />   (setq ptright (getpoint "\n选择最右点:"))<br />   (setq x2 (car ptright))<br />   (print x2)<br />   <br />   (setq ptbottom (getpoint "\n选择最底点:"))<br />   (setq y1 (cadr ptbottom))<br />   (print y1)<br />   <br />   (setq pttop (getpoint "\n选择最顶点:"))<br />   (setq y2 (cadr pttop))<br />   (print y2)<br />   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list (- x1 CTLenth) y1))(cons 11 (list (+ x2 CTLenth) y1))))<br />   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list (- x1 CTLenth) y2))(cons 11 (list (+ x2 CTLenth) y2))))<br />   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list x1 (- y1 CTLenth)))(cons 11 (list x1 (+ y2 CTLenth)))))<br />   (entmake (list '(0 . "LINE")(cons 62 8)(cons 10 (list x2 (- y1 CTLenth)))(cons 11 (list x2 (+ y2 CTLenth)))))<br />   (setvar "blipmode" sb)<br />   (princ)<br /> )

xyp1964

1. (defun c:ctx (/ aa bb co dl ll os rr tt x1 x2 y1 y2)
   
2.   (defun line (p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))
   
3.   (setq co (getvar "cecolor"))
   
4.   (setq os (getvar "osmode"))
   
5.   (setvar "cecolor" "8")
   
6.   (setvar "osmode" 39)
   
7.   (setvar "cmdecho" 0)
   
8.   (setq aa (getvar "dimscale"))
   
9.   (setq dl (* aa 6))
   
10.   (if (and (setq tt (getpoint "\n选择最顶点: "))
    
11.            (setq bb (getpoint "\n选择最底点: "))
    
12.            (setq ll (getpoint "\n选择最左点: "))
    
13.            (setq rr (getpoint "\n选择最右点: "))
    
14.       )
    
15.     (progn
    
16.       (setq x1 (car ll)
    
17.             x2 (car rr)
    
18.             y1 (cadr bb)
    
19.             y2 (cadr tt)
    
20.       )
    
21.       (line (list (- x1 dl) y1) (list (+ x2 dl) y1))
    
22.       (line (list (- x1 dl) y2) (list (+ x2 dl) y2))
    
23.       (line (list x1 (- y1 dl)) (list x1 (+ y2 dl)))
    
24.       (line (list x2 (- y1 dl)) (list x2 (+ y2 dl)))
    
25.     )
    
26.   )
    
27.   (setvar "cecolor" co)
    
28.   (setvar "osmode" os)
    
29.   (setvar "cmdecho" 1)
    
30.   (princ)
    
31. )

(defun c:ctx (/ aa bb co dl ll os rr tt x1 x2 y1 y2)<br />   (defun line (p1 p2)(entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2))))<br />   (setq co (getvar "cecolor"))<br />   (setq os (getvar "osmode"))<br />   (setvar "cecolor" "8") <br />   (setvar "osmode" 39)<br />   (setvar "cmdecho" 0)<br />   (setq aa (getvar "dimscale"))<br />   (setq dl (* aa 6))<br />   (if (and (setq tt (getpoint "\n选择最顶点: "))<br />            (setq bb (getpoint "\n选择最底点: "))<br />            (setq ll (getpoint "\n选择最左点: "))<br />            (setq rr (getpoint "\n选择最右点: "))<br />       )<br />     (progn<br />       (setq x1 (car ll)<br />             x2 (car rr)<br />             y1 (cadr bb)<br />             y2 (cadr tt)<br />       )<br />       (line (list (- x1 dl) y1) (list (+ x2 dl) y1))<br />       (line (list (- x1 dl) y2) (list (+ x2 dl) y2))<br />       (line (list x1 (- y1 dl)) (list x1 (+ y2 dl)))<br />       (line (list x2 (- y1 dl)) (list x2 (+ y2 dl)))<br />     )<br />   )<br />   (setvar "cecolor" co)<br />   (setvar "osmode" os)<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

xtjd

(defun c:ctx(/ dd gbo mkl p1 p2 p3 p4 ps pxa pxb pya pyb ss)
  (setvar "cmdecho" 0)
  (defun gbo(obj / p1 p2)(vla-getboundingbox obj 'p1 'p2)(mapcar 'vlax-safearray->list (list p1 p2)))
  (defun mkl(p1 p2)(entmakex(list  '(0 . "LINE")'(62 . 8)(cons 10 p1)(cons 11 p2))))
  (if(setq ss(ssget '((0 . "*LINE,ARC,CIRCLE"))))
    (progn
      (setq
        dd(*(getvar "dimscale")6)
        ps(mapcar 'gbo(mapcar 'vlax-ename->vla-object(vl-remove-if 'listp(mapcar 'cadr(ssnamex ss)))))
        pxa(apply 'min(mapcar 'caar ps))
        pya(apply 'min(mapcar 'cadar ps))
        pxb(apply 'max(mapcar 'caadr ps))
        pyb(apply 'max(mapcar 'cadadr ps))
        p1(list pxa pya)
        p2(list pxb pya)
        p3(list pxb pyb)
        p4(list pxa pyb)
      )
      (mkl(polar p1 pi dd)(polar p2 0 dd))
      (mkl(polar p2(* pi 1.5)dd)(polar p3(* pi 0.5)dd))
      (mkl(polar p3 0 dd)(polar p4 pi dd))
      (mkl(polar p4(* pi 0.5)dd)(polar p1(* pi 1.5)dd))
    )
  )
  (prin1)
)

raimo

飞雪神光 发表于 2024-8-22 11:52
用command 绘图要关闭捕捉 你却都打开 要是改为包围盒只需要框选一下就可以 不用指定四点

因为是图纸，外边界情况会比较复杂，有时候还有标注线啥的。所以我目前就只想到选择四点比较方便

飞雪神光

raimo 发表于 2024-8-22 12:26
因为是图纸，外边界情况会比较复杂，有时候还有标注线啥的。所以我目前就只想到选择四点比较方便

可以过滤掉 只取 直线 多段线

raimo

飞雪神光 发表于 2024-8-22 12:29
可以过滤掉 只取 直线 多段线

还是先谢谢，我是不知道command的这个设定，难怪老出问题。
过滤掉的话，还会有弧形墙的情况，也可以做到吗。
另外如果可能，有可能实现自动填充的功能吗？思路是咋样的？

飞雪神光

raimo 发表于 2024-8-22 13:13
还是先谢谢，我是不知道command的这个设定，难怪老出问题。
过滤掉的话，还会有弧形墙的情况，也可以做 ...

都可以 就是填充比较难了

xyp1964

;; 框选方式更简洁高效

raimo

xyp1964 发表于 2024-8-22 13:47
;; 框选方式更简洁高效

版主，你发这个不是框选吧？