LISP画最小矩形代码

gisshow1

学习学习 看是如何实现的

诺捷GOGO

谢谢，，学习

LXH@123

厉害   向大师学习   拿走了

谢贵555

感谢版主为我们提供这么好的代码

Urings

看看先，顶一个

a365914976

学习一下！！！！！

xingwan2013

下载试用、学习提高。

tungping_pan

谢谢分享!!!

tungping_pan

非常感谢，谢谢分享!

cioceoio

2. (defun C:aq (/ PP PTLIST SEL T0 n)
   
3.   (setq sel (ssget (list '(0 . "POINT,LWPOLYLINE,LINE,SPLINE,CIRCLE,ELLIPSE"))))
   
4. ;中间代码相同省略
   
5. );end-defun
   
6. (defun getpt (ss n / i s a b c cc d d0 v vs e plnam)
   
7.         (setq i 0)
   
8.         (if ss
   
9.         (repeat (sslength ss)
   
10.         (setq a (ssname ss i)
    
11.         b (entget a)
    
12.         e (cdr (assoc 0 b)))
    
13.         (cond
    
14.         ((= e "LWPOLYLINE")
    
15.         (setq c (get-pline-pts a n))
    
16.         (setq s (append c s))
    
17.         )
    
18.         ((= e "ARC")
    
19.         (command "pedit" a "")
    
20.         (setq plnam (entlast))
    
21.         (setq c (get-pline-pts plnam n))
    
22.         (setq s (append c s))
    
23.         (vl-cmdf "_explode" plnam)
    
24.         )
    
25.         ((= e "CIRCLE")
    
26.         (setq c (get-circle-pts a n))
    
27.         (setq s (append c s))
    
28.         )
    
29.         ((= e "SPLINE")
    
30.         (setq c (get-spline-pts a n))
    
31.         (setq s (append c s))
    
32.         )
    
33.         ((= e "ELLIPSE")
    
34.         (setq d0 0.000001
    
35.         v (vlax-ename->vla-object a)
    
36.         vs (vla-Offset v d0)
    
37.         plnam (entlast))
    
38.         (setq c (get-spline-pts plnam n))
    
39.         (setq s (append c s))
    
40.         (entdel plnam)
    
41.         )
    
42.         ((= e "LINE")
    
43.         (setq c (cdr (assoc 10 b))
    
44.         d (cdr (assoc 11 b))
    
45.         c (list (car c) (cadr c))
    
46.         d (list (car d) (cadr d))
    
47.         s (cons c s)
    
48.         s (cons d s))
    
49.         )
    
50.         ((= e "POINT")
    
51.         (setq c (cdr (assoc 10 b))
    
52.         c (list (car c) (cadr c))
    
53.         s (cons c s))
    
54.         )
    
55.         )
    
56.         (setq i (1+ i))
    
57.         )
    
58.         )
    
59.         s
    
60. )
    
61. (defun get-circle-pts (ent n / x0 y0 r i dist seg pt pts)
    
62.         (setq x0 (car (cdr (assoc 10 (entget ent))))
    
63.         y0 (cadr (cdr (assoc 10 (entget ent))))
    
64.         r (cdr (assoc 40 (entget ent)))
    
65.         dist 0
    
66.         seg (/ (* pi r) n)
    
67.         pts '()
    
68.         i -1)
    
69.         (while (<= i (* n 2))
    
70.         (setq i (1+ i)
    
71.         dist (* i seg)
    
72.         pt (list (+ x0 (* r (cos dist))) (+ y0 (* r (sin dist))) 0.0))
    
73.         (setq pts (cons pt pts))
    
74.         )
    
75.         (reverse pts)
    
76. )

(defun C:aq (/ PP PTLIST SEL T0 n)<br />   (setq sel (ssget (list '(0 . "POINT,LWPOLYLINE,LINE,SPLINE,CIRCLE,ELLIPSE"))))<br /> ;中间代码相同省略<br /> );end-defun<br /> (defun getpt (ss n / i s a b c cc d d0 v vs e plnam)<br />         (setq i 0)<br />         (if ss<br />         (repeat (sslength ss)<br />         (setq a (ssname ss i)<br />         b (entget a)<br />         e (cdr (assoc 0 b)))<br />         (cond<br />         ((= e "LWPOLYLINE")<br />         (setq c (get-pline-pts a n))<br />         (setq s (append c s))<br />         )<br />         ((= e "ARC")<br />         (command "pedit" a "")<br />         (setq plnam (entlast))<br />         (setq c (get-pline-pts plnam n))<br />         (setq s (append c s))<br />         (vl-cmdf "_explode" plnam)<br />         )<br />         ((= e "CIRCLE")<br />         (setq c (get-circle-pts a n))<br />         (setq s (append c s))<br />         )<br />         ((= e "SPLINE")<br />         (setq c (get-spline-pts a n))<br />         (setq s (append c s))<br />         )<br />         ((= e "ELLIPSE")<br />         (setq d0 0.000001<br />         v (vlax-ename->vla-object a)<br />         vs (vla-Offset v d0)<br />         plnam (entlast))<br />         (setq c (get-spline-pts plnam n))<br />         (setq s (append c s))<br />         (entdel plnam)<br />         )<br />         ((= e "LINE")<br />         (setq c (cdr (assoc 10 b))<br />         d (cdr (assoc 11 b))<br />         c (list (car c) (cadr c))<br />         d (list (car d) (cadr d))<br />         s (cons c s)<br />         s (cons d s))<br />         )<br />         ((= e "POINT")<br />         (setq c (cdr (assoc 10 b))<br />         c (list (car c) (cadr c))<br />         s (cons c s))<br />         )<br />         )<br />         (setq i (1+ i))<br />         )<br />         )<br />         s<br /> )<br /> (defun get-circle-pts (ent n / x0 y0 r i dist seg pt pts)<br />         (setq x0 (car (cdr (assoc 10 (entget ent))))<br />         y0 (cadr (cdr (assoc 10 (entget ent))))<br />         r (cdr (assoc 40 (entget ent)))<br />         dist 0<br />         seg (/ (* pi r) n)<br />         pts '()<br />         i -1)<br />         (while (<= i (* n 2))<br />         (setq i (1+ i)<br />         dist (* i seg)<br />         pt (list (+ x0 (* r (cos dist))) (+ y0 (* r (sin dist))) 0.0))<br />         (setq pts (cons pt pts))<br />         )<br />         (reverse pts)<br /> )

添加支持圆弧,圆和椭圆

wc763230796

学习一下

w15994259099

看看先，顶一个

jaimuthu1983

awesome its use  very good

a117034423

好东西 谢谢了 也不知道你还在不在论坛了

sqsxsqsx

看看我有个图外包会出错能用不