根据原有矩形尺寸按右上角顶点画另一个尺寸矩形

903242237

根据里面的矩形的右上角的点画外面的矩形，外面的矩形横向尺寸是100的倍数，纵向尺寸是10的倍数。
求插件，或函数FLOOR在LISP中的用法，谢谢！

newbuser

这个应该很容易做到啊。

newbuser

(defun c:ts ( / os p1 p2 p3 p4 p5 p6 p7 heng zong out_heng out_zong)
  (setq os (getvar 'osmode))
  (setq p1 (getpoint "\n 请输入矩形右上角点"))
  (setq heng (getdist "请输入里面矩形横向长度==>> "))
  (setq zong (getdist "请输入里面矩形纵向长度==>> "))
  (setq out_heng (* (+ (fix (/ heng 100)) 1) 100))
  (setq out_zong (* (+ (fix (/ zong 10)) 2) 10))
  (setq p2 (polar p1 (angle '(0 0) '(0 -1)) zong))
  (setq p3 (polar p2 (angle '(0 0) '(-1 0)) heng))
  (setq p4 (polar p1 (angle '(0 0) '(-1 0)) heng))
  (setq p5 (polar p1 (angle '(0 0) '(0 -1)) out_zong))
  (setq p6 (polar p5 (angle '(0 0) '(-1 0)) out_heng))
  (setq p7 (polar p1 (angle '(0 0) '(-1 0)) out_heng))
  (setvar 'osmode 0)
  (command "pline" p1 p2 p3 p4 "c")
  (command "pline" p1 p5 p6 p7 "c")
  (command "DIMALIGNED" p7 p1 (polar p1 (angle '(0 0) '(0 1)) 80))
  (command "DIMALIGNED" p4 p1 (polar p1 (angle '(0 0) '(0 1)) 40))
  (command "DIMALIGNED" p7 p6 (polar p6 (angle '(0 0) '(-1 0)) 80))
  (command "DIMALIGNED" p1 p2 (polar p1 (angle '(0 0) '(-1 0)) 80))
  (setvar 'osmode os)
  )
(defun mk-polyline (lst /)
  (entmake (append (list '(0 . "LWPOLYLINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbPolyline")
                         (cons 90 (length lst))
                   )
                   (mapcar '(lambda (pt) (cons 10 pt)) lst)
           )
  )
)

重慶崽兒

额  我也写了个，不知道有没有满足要求

2. (defun c:tt( / dix diy en fix_heng fix_zong heng heng_1 i lst pt pt_1 pt_2 pt_3 zong zong_1)
   
3.   (setq en (entget (car (entsel "\n选择矩形:"))))
   
4.   (setq pt (reverse (cdr (reverse (getpoint "\n选择右上角点:")))))
   
5.   (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) en)))
   
6.   (setq i 0)
   
7.   (repeat 4
   
8.     (setq dix (car (nth i lst)))
   
9.     (setq diy (cadr (nth i lst)))
   
10.     (cond
    
11.       ((< dix (car pt)) (setq heng (- (car pt) dix)))
    
12.       ((< diy (cadr pt)) (setq zong (- (cadr pt) diy)))
    
13.     )
    
14.     (setq i (1+ i))
    
15.   )
    
16.   (setq fix_heng (fix (/ heng 100.0)))
    
17.   (setq fix_zong (fix (/ zong 10.0)))
    
18.   (setq heng_1 (* (+ fix_heng 1) 100))
    
19.   (setq zong_1 (* (+ fix_zong 1) 10))
    
20.   (setq pt_1 (list 10 (- (car pt) heng_1) (cadr pt))
    
21.         pt_2 (list 10 (- (car pt) heng_1) (- (cadr pt) zong_1))
    
22.   pt_3 (list 10 (car pt) (- (cadr pt) zong_1))
    
23.   )
    
24.   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 pt) pt_1 pt_2 pt_3))
    
25.   (princ)
    
26. )

(defun c:tt( / dix diy en fix_heng fix_zong heng heng_1 i lst pt pt_1 pt_2 pt_3 zong zong_1)<br />   (setq en (entget (car (entsel "\n选择矩形:"))))<br />   (setq pt (reverse (cdr (reverse (getpoint "\n选择右上角点:")))))<br />   (setq lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) en)))<br />   (setq i 0)<br />   (repeat 4<br />     (setq dix (car (nth i lst)))<br />     (setq diy (cadr (nth i lst)))<br />     (cond<br />       ((< dix (car pt)) (setq heng (- (car pt) dix)))<br />       ((< diy (cadr pt)) (setq zong (- (cadr pt) diy)))<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq fix_heng (fix (/ heng 100.0)))<br />   (setq fix_zong (fix (/ zong 10.0)))<br />   (setq heng_1 (* (+ fix_heng 1) 100))<br />   (setq zong_1 (* (+ fix_zong 1) 10))<br />   (setq pt_1 (list 10 (- (car pt) heng_1) (cadr pt))<br />         pt_2 (list 10 (- (car pt) heng_1) (- (cadr pt) zong_1))<br />   pt_3 (list 10 (car pt) (- (cadr pt) zong_1))<br />   )<br />   (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 10 pt) pt_1 pt_2 pt_3))<br />   (princ)<br /> )

903242237

newbuser 发表于 2015-7-8 18:55
(defun c:ts ( / os p1 p2 p3 p4 p5 p6 p7 heng zong out_heng out_zong)
  (setq os (getvar 'osmode ...

谢谢

903242237

重慶崽兒 发表于 2015-7-8 19:45
额  我也写了个，不知道有没有满足要求

谢谢，挺好的