求大神帮忙写个偏移画矩形的lisp

那个猎人

我是做设计的，平时玻璃提料需要在分格的基础上四周偏移才能出玻璃尺寸。不知能不能实现自动生成玻璃轮廓。
具体过程是这样的，点击白色中间区域，先判断区域内是否为矩形，不是就提示。是矩形的话就提示输入左右上下需要偏移的距离（A,B,C,D）,可以为正负，然后根据四个尺寸，每个边偏移相应的距离，生成红色或者粉红色的玻璃轮廓。
求大神帮忙。

Andyhon

命题不难,可是发错版块了
http://bbs.mjtd.com/thread-100603-1-1.html

那个猎人

Andyhon 发表于 2014-4-29 16:13
命题不难,可是发错版块了
http://bbs.mjtd.com/thread-100603-1-1.html

哈哈，新手不知道，那我转过去。

langjs

莫非是这个玩意？


(defun c:qqq (/ a b c d ent lst n name pt)
  (defun jspt (pt a b) (list (+ (car pt) a) (+ (cadr pt) b)))
  (setvar "cmdecho" 0)
  (command "_boundary" (getpoint "\n拾取内部点:") "")
  (if (and (setq ent (entget (setq name (entlast))))
        (= (cdr (assoc 0 ent)) "LWPOLYLINE")(= (cdr (assoc 90 ent)) 4))
    (progn (entdel name) (setq lst '())
      (foreach n ent(if (= (car n) 10) (setq lst (cons (cdr n) lst))))
      (if (null lstbak001) (setq lstbak001 '(10.0 10.0 10.0 10.0)))
      (setq a (car lstbak001)   b (cadr lstbak001) c (caddr lstbak001) d (cadddr lstbak001))
      (if (setq n (getreal (strcat "\n向左偏移：<" (rtos a) ">"))) (setq a n))
      (if (setq n (getreal (strcat "\n向上偏移：<" (rtos b) ">"))) (setq b n))
      (if (setq n (getreal (strcat "\n向右偏移：<" (rtos c) ">"))) (setq c n))
      (if (setq n (getreal (strcat "\n向下偏移：<" (rtos d) ">"))) (setq d n))
      (setq lstbak001 (list a b c d))
      (setq lst (list (jspt (car lst) c (* -1 d)) (jspt (cadr lst) (* -1 a) (* -1 d))
      (jspt (caddr lst) (* -1 a) b) (jspt (cadddr lst) c b) (jspt (car lst) c (* -1 d))))
      (entmake (append(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
      (mapcar  '(lambda (pt) (cons 10 pt)) lst )))))
  (princ)
)

那个猎人

langjs 发表于 2014-4-30 12:31
莫非是这个玩意？

先赞一个，谢谢哈。就是这样，不过能否这样
1.先输入左右上下四个距离，然后点击生成偏移框，再点击又生成偏移框。就是输入一次距离后可以连续点击生成框。
2.这个遇到非四边形的会执行boundary命令生成轮廓，能否判断非四边形后删除生成的轮廓。

那个猎人

langjs 发表于 2014-4-30 12:31
莫非是这个玩意？

大神你好，我在lisp方面是个菜鸟，研究了半天，一句话一句话的查帮助，加上注释才搞明白。然后因为我想先输入距离，再连续点击，所以我把输入距离放到前面，但是怎么能够连续点击不会弄，请大神指点啊

(defun c:qqq (/ a b c d ent lst n name pt)
  (defun jspt (pt a b)
                (list (+ (car pt) a) (+ (cadr pt) b))
   )
   (if (null lstbak001)
                        (setq lstbak001 '(10.0 10.0 10.0 10.0));默认四边偏移距离
           )
      (setq a (car lstbak001)   b (cadr lstbak001) c (caddr lstbak001) d (cadddr lstbak001));四边偏移量定义为变量
      (if (setq n (getreal (strcat "\n向左偏移：<" (rtos a) ">")))
                        (setq a n);定义变量a，若输入实数则存入a；若无输入，则a为默认值
           )
      (if (setq n (getreal (strcat "\n向上偏移：<" (rtos b) ">")))
                        (setq b n)
           )
      (if (setq n (getreal (strcat "\n向右偏移：<" (rtos c) ">")))
                        (setq c n)
           )
      (if (setq n (getreal (strcat "\n向下偏移：<" (rtos d) ">")))
                        (setq d n)
           )
      (setq lstbak001 (list a b c d));四边偏移值存入数组
  (setvar "cmdecho" 0)
  (command "_boundary" (getpoint "\n拾取内部点:") "");创建边界
  (if (and (setq ent (entget (setq name (entlast))))
        (= (cdr (assoc 0 ent)) "LWPOLYLINE")(= (cdr (assoc 90 ent)) 4));判断边界是否为四个顶点的多段线
    (progn (entdel name) (setq lst '())
      (foreach n ent
                        (if (= (car n) 10)
                                (setq lst (cons (cdr n) lst));遍历边界组合，将顶点存入lst内
                        )
           )
            (setq lst (list (jspt (car lst) c (* -1 d)) ;边界第一点（右下角点）x坐标加c，y坐标减d
                                          (jspt (cadr lst) (* -1 a) (* -1 d));边界第二点（左下角点）x坐标减a，y坐标减d
                                          (jspt (caddr lst) (* -1 a) b);边界第三点（左上角点）x坐标减a，y坐标加b
                                          (jspt (cadddr lst) c b);边界第四点（右上角点）x坐标加c，y坐标加b
                                          (jspt (car lst) c (* -1 d));边界第一点（右下角点）x坐标加c，y坐标减d，这个点不加，生成的矩形不闭合
                                 ));通过变换，将偏移后的矩形顶点的二维坐标点存入lst中
      (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
                                                (mapcar  '(lambda (pt) (cons 10 pt)) lst ))))
          (entdel name)
          )
  (princ)
)

那个猎人

langjs 发表于 2014-4-30 12:31
莫非是这个玩意？

我加了个重复1000次，然后就可以一直重复了，要退出就按esc，请大神们指教，新手哈，请多多鼓励哦

(defun c:qqq (/ a b c d ent lst n name pt)
  (defun jspt (pt a b)
                (list (+ (car pt) a) (+ (cadr pt) b))
   )
   (if (null lstbak001)
                        (setq lstbak001 '(10.0 10.0 10.0 10.0));默认四边偏移距离
           )
      (setq a (car lstbak001)   b (cadr lstbak001) c (caddr lstbak001) d (cadddr lstbak001));四边偏移量定义为变量
      (if (setq n (getreal (strcat "\n向左偏移：<" (rtos a) ">")))
                        (setq a n);定义变量a，若输入实数则存入a；若无输入，则a为默认值
           )
      (if (setq n (getreal (strcat "\n向上偏移：<" (rtos b) ">")))
                        (setq b n)
           )
      (if (setq n (getreal (strcat "\n向右偏移：<" (rtos c) ">")))
                        (setq c n)
           )
      (if (setq n (getreal (strcat "\n向下偏移：<" (rtos d) ">")))
                        (setq d n)
           )
      (setq lstbak001 (list a b c d));四边偏移值存入数组
  (setvar "cmdecho" 0)
  (repeat 1000
  (setq point (getpoint "\n拾取内部点:"))
  (command "_boundary" point "");创建边界
  (if (and (setq ent (entget (setq name (entlast))))
        (= (cdr (assoc 0 ent)) "LWPOLYLINE")(= (cdr (assoc 90 ent)) 4));判断边界是否为四个顶点的多段线
    (progn (entdel name) (setq lst '())
      (foreach n ent
                        (if (= (car n) 10)
                                (setq lst (cons (cdr n) lst));遍历边界组合，将顶点存入lst内
                        )
           )
            (setq lst (list (jspt (car lst) c (* -1 d)) ;边界第一点（右下角点）x坐标加c，y坐标减d
                                          (jspt (cadr lst) (* -1 a) (* -1 d));边界第二点（左下角点）x坐标减a，y坐标减d
                                          (jspt (caddr lst) (* -1 a) b);边界第三点（左上角点）x坐标减a，y坐标加b
                                          (jspt (cadddr lst) c b);边界第四点（右上角点）x坐标加c，y坐标加b
                                          (jspt (car lst) c (* -1 d));边界第一点（右下角点）x坐标加c，y坐标减d，这个点不加，生成的矩形不闭合
                                 ));通过变换，将偏移后的矩形顶点的二维坐标点存入lst中
      (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)))
                                                (mapcar  '(lambda (pt) (cons 10 pt)) lst ))))
          (entdel name)
          )
          )
  (princ)
)

kwok

那个猎人 发表于 2014-4-30 18:47
我加了个重复1000次，然后就可以一直重复了，要退出就按esc，请大神们指教，新手哈，请多多鼓励哦

(de ...

循环的话把  (repeat 1000   改成  (while   

ZZXXQQ

2. (defun c:qqq (/ a b c d ent lst n name pt)
   
3. (defun jspt (pt a b) (mapcar '+ pt (list a b)))
   
4. (if (null lstbak001)
   
5.   (setq lstbak001 '(10.0 10.0 10.0 10.0));默认四边偏移距离
   
6. )
   
7. (setq a (car lstbak001) b (cadr lstbak001) c (caddr lstbak001) d (cadddr lstbak001));四边偏移量定义为变量
   
8. (if (setq n (getreal (strcat "\n向左偏移：<" (rtos a) ">")))
   
9.   (setq a n);定义变量a，若输入实数则存入a；若无输入，则a为默认值
   
10. )
    
11. (if (setq n (getreal (strcat "\n向上偏移：<" (rtos b) ">")))
    
12.   (setq b n)
    
13. )
    
14. (if (setq n (getreal (strcat "\n向右偏移：<" (rtos c) ">")))
    
15.   (setq c n)
    
16. )
    
17. (if (setq n (getreal (strcat "\n向下偏移：<" (rtos d) ">")))
    
18.   (setq d n)
    
19. )
    
20. (setq lstbak001 (list a b c d));四边偏移值存入数组
    
21. (setvar "cmdecho" 0)
    
22. (while (setq point (getpoint "\n拾取内部点:"))
    
23.   (command "_boundary" point "");创建边界
    
24.   (if (and (setq ent (entget (setq name (entlast))))
    
25.         (= (cdr (assoc 0 ent)) "LWPOLYLINE")(= (cdr (assoc 90 ent)) 4));判断边界是否为四个顶点的多段线
    
26.   (progn
    
27.    (setq lst '())
    
28.    (foreach n ent
    
29.     (if (= (car n) 10)
    
30.      (setq lst (cons (cdr n) lst));遍历边界组合，将顶点存入lst内
    
31.     )
    
32.    )
    
33.    (setq lst (list (jspt (car lst) c (- d)) ;边界第一点（右下角点）x坐标加c，y坐标减d
    
34.     (jspt (cadr lst) (- a) (- d));边界第二点（左下角点）x坐标减a，y坐标减d
    
35.     (jspt (caddr lst) (- a) b);边界第三点（左上角点）x坐标减a，y坐标加b
    
36.     (jspt (cadddr lst) c b);边界第四点（右上角点）x坐标加c，y坐标加b
    
37.     (jspt (car lst) c (- d));边界第一点（右下角点）x坐标加c，y坐标减d，这个点不加，生成的矩形不闭合
    
38.    ));通过变换，将偏移后的矩形顶点的二维坐标点存入lst中
    
39.    (entmake
    
40.     (append
    
41.      (list
    
42.       '(0 . "LWPOLYLINE")
    
43.       '(100 . "AcDbEntity")
    
44.       '(100 . "AcDbPolyline")
    
45.       (cons 90 (length lst))
    
46.      )
    
47.      (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
48.     )
    
49.    )
    
50.   ))
    
51.   (entdel name)
    
52. )
    
53. (princ)
    
54. )

(defun c:qqq (/ a b c d ent lst n name pt)<br /> (defun jspt (pt a b) (mapcar '+ pt (list a b)))<br /> (if (null lstbak001)<br />   (setq lstbak001 '(10.0 10.0 10.0 10.0));默认四边偏移距离<br /> )<br /> (setq a (car lstbak001) b (cadr lstbak001) c (caddr lstbak001) d (cadddr lstbak001));四边偏移量定义为变量<br /> (if (setq n (getreal (strcat "\n向左偏移：<" (rtos a) ">")))<br />   (setq a n);定义变量a，若输入实数则存入a；若无输入，则a为默认值<br /> )<br /> (if (setq n (getreal (strcat "\n向上偏移：<" (rtos b) ">")))<br />   (setq b n)<br /> )<br /> (if (setq n (getreal (strcat "\n向右偏移：<" (rtos c) ">")))<br />   (setq c n)<br /> )<br /> (if (setq n (getreal (strcat "\n向下偏移：<" (rtos d) ">")))<br />   (setq d n)<br /> )<br /> (setq lstbak001 (list a b c d));四边偏移值存入数组<br /> (setvar "cmdecho" 0)<br /> (while (setq point (getpoint "\n拾取内部点:"))<br />   (command "_boundary" point "");创建边界<br />   (if (and (setq ent (entget (setq name (entlast))))<br />         (= (cdr (assoc 0 ent)) "LWPOLYLINE")(= (cdr (assoc 90 ent)) 4));判断边界是否为四个顶点的多段线<br />   (progn<br />    (setq lst '())<br />    (foreach n ent<br />     (if (= (car n) 10)<br />      (setq lst (cons (cdr n) lst));遍历边界组合，将顶点存入lst内<br />     )<br />    )<br />    (setq lst (list (jspt (car lst) c (- d)) ;边界第一点（右下角点）x坐标加c，y坐标减d<br />     (jspt (cadr lst) (- a) (- d));边界第二点（左下角点）x坐标减a，y坐标减d<br />     (jspt (caddr lst) (- a) b);边界第三点（左上角点）x坐标减a，y坐标加b<br />     (jspt (cadddr lst) c b);边界第四点（右上角点）x坐标加c，y坐标加b<br />     (jspt (car lst) c (- d));边界第一点（右下角点）x坐标加c，y坐标减d，这个点不加，生成的矩形不闭合<br />    ));通过变换，将偏移后的矩形顶点的二维坐标点存入lst中<br />    (entmake<br />     (append<br />      (list<br />       '(0 . "LWPOLYLINE")<br />       '(100 . "AcDbEntity")<br />       '(100 . "AcDbPolyline")<br />       (cons 90 (length lst))<br />      )<br />      (mapcar '(lambda (pt) (cons 10 pt)) lst)<br />     )<br />    )<br />   ))<br />   (entdel name)<br /> )<br /> (princ)<br /> )

emk

搞得好复杂