求程序 给出一个点 输入长度 宽度自动生成长圆孔

1550855711

求程序 给出一个点 输入长度 宽度自动生成长圆孔

ssyfeng

看看效果：

1550855711

ssyfeng 发表于 2023-11-11 18:32
看看效果：

对 就是这样的 能分享一下程序？？  

xj6019

楼上是专业写程序的，给钱就分享了

llsheng_73

1. (defun c:tt(/ p a0 b0 a b x1 y2 y1 y2 b1 b2)
   
2.   (while(and(setq p(getpoint"\n左上角点:"))
   
3.             (or(setq a(getdist(strcat"长度"(if a0(rtos a0 2 2)""))))
   
4.                (setq a a0))
   
5.             (or(setq b(getdist(strcat"宽度"(if b0(rtos b0 2 2)""))))
   
6.                (setq b b0))
   
7.             (>(setq a(abs a))0)
   
8.             (>(setq b(abs b))0)
   
9.             (setq a0 a b0 b)
   
10.             (if(> a b)
    
11.               (setq x1(* b 0.5)y1 0 x2(- a x1)y2(- b)b1 0 b2 -1)
    
12.               (setq x1 0 y1(* a -0.5)x2 a y2(-(- y1)b)b1 -1 b2 0))
    
13.             (entmakex(mapcar'cons'(0 100 100 90 70 10 42 10 42 10 42 10 42)
    
14.                             (list"LWPOLYLINE""AcDbEntity""AcDbPolyline"4 1
    
15.                                  (mapcar'+(list x1 y1)p)b1
    
16.                                  (mapcar'+(list x2 y1)p)b2
    
17.                                  (mapcar'+(list x2 y2)p)b1
    
18.                                  (mapcar'+(list x1 y2)p)b2))))))

(defun c:tt(/ p a0 b0 a b x1 y2 y1 y2 b1 b2)<br />   (while(and(setq p(getpoint"\n左上角点:"))<br />             (or(setq a(getdist(strcat"长度"(if a0(rtos a0 2 2)""))))<br />                (setq a a0))<br />             (or(setq b(getdist(strcat"宽度"(if b0(rtos b0 2 2)""))))<br />                (setq b b0))<br />             (>(setq a(abs a))0)<br />             (>(setq b(abs b))0)<br />             (setq a0 a b0 b)<br />             (if(> a b)<br />               (setq x1(* b 0.5)y1 0 x2(- a x1)y2(- b)b1 0 b2 -1)<br />               (setq x1 0 y1(* a -0.5)x2 a y2(-(- y1)b)b1 -1 b2 0))<br />             (entmakex(mapcar'cons'(0 100 100 90 70 10 42 10 42 10 42 10 42)<br />                             (list"LWPOLYLINE""AcDbEntity""AcDbPolyline"4 1<br />                                  (mapcar'+(list x1 y1)p)b1<br />                                  (mapcar'+(list x2 y1)p)b2<br />                                  (mapcar'+(list x2 y2)p)b1<br />                                  (mapcar'+(list x1 y2)p)b2))))))

zhangcan0515

看看是否符合要求

czb203

zhangcan0515 发表于 2023-11-11 22:18
看看是否符合要求

这个界面很哇塞

xibiao

zhangcan0515 发表于 2023-11-11 22:18
看看是否符合要求

实用功能，求分享