自由矩形（第三版）

newer · 发表于 2018-8-30 17:19:44

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

同前几版比较，增加了
1、轴向设置
2、宽度设置
3、颜色设置
4、回退

请在2018.08.30日以后更新的API下使用。

(defun c:XDTB_RectFree (/ e1 e2 el ents ents-bak
info info1 m_rec_ent n num
p_1 p_2 p1 p2 ra ss
tmp val x xdir
)
(defun _process (e1 e2)
(setq ra (xd::curve:relation e2 e1))
(cond ((or (= ra 0) (= ra 4)))
((or (= ra 2) (= ra 3)) (setq tmp (xdrx_get_union e1 e2)))
((= ra 1) (setq tmp (xdrx_get_subtract e2 e1)))
)
(if tmp
(setq ents (append (xdrx_pickset->ents tmp) ents))
)
(xdrx_draworder->top
(setq ents (_clear (xd::list:removedup ents)))
)
)
(defun _clear (el)
(setq el (vl-remove nil
(mapcar '(lambda (x)
(if (and x (entget x))
x
)
)
el
)
)
)
(xdrx_polyline_compress el t)
el
)
(xdrx_begin)
(if (not #xd_var_global_lw_width)
(setq #xd_var_global_lw_width 1.0)
)
(if (not #xd_var_global_ent_color)
(setq #xd_var_global_ent_color 7)
)
(setq m_rec_ent nil
xdir (getvar "ucsxdir")
)
(xdrx_initssget "\n选取添加已有要处理的矩形<不选>:")
(setq ss (xdrx_ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(setq ents (xdrx_pickset->ents ss)
ents-bak ents
)
(setq num 0)
(while
(and (xd::doc:setosnap 547)
(if (> num 0)
(progn (setq info1 "/回退(U)") (xdrx_initget "A W C U"))
(progn (setq info1 "") (xdrx_initget "A W C"))
)
(setq info (strcat "\n矩形第一点[设置轴(A)/宽度(W)/颜色(C)"
info1
"]<退出>:"
)
)
(xdrx_prompt
"\n当前设置：线宽(" #xd_var_global_lw_width
") 颜色(" #xd_var_global_ent_color
")"
)
(setq p1 (getpoint info))
(cond ((= p1 "W")
(if (setq val (getreal (xdrx_prompt
"\n输入线宽度<"
#xd_var_global_lw_width
">:"
t
)
)
)
(progn (setq #xd_var_global_lw_width val)
(xdrx_entity_setproperty
ents
"constantwidth"
#xd_var_global_lw_width
)
)
)
t
)
((= p1 "C")
(setq #xd_var_global_ent_color
(acad_colordlg
#xd_var_global_ent_color
)
)
(xdrx_entity_setproperty
ents
"color"
#xd_var_global_ent_color
)
t
)
((= p1 "U")
(if (/= num 0)
(progn (vl-cmdf "undo" 2)
(setq num (1- num))
(setq ents (_clear ents-bak))
(if (= num 0)
(princ "\r所有操作已经回退完毕！")
)
)
)
t
)
((= p1 "A")
(if (and (setq p_1 (getpoint "\n轴线第一点<退出>:"))
(setq p_2 (getpoint p_1 "\n轴线第二点<退出>:"))
)
(progn (setq xdir (xdrx_vector_normalize
(mapcar '- (trans p_2 1 0) (trans p_1 1 0))
)
xdir (if (minusp (car xdir))
(setq xdir (xdrx_vector_negate xdir))
xdir
)
)
)
)
t
)
((= (type p1) 'LIST) t)
)
(progn
(and (= (type p1) 'LIST)
(setq p2 (xd::doc:getcorner p1 "\r矩形第二点<退出>:" 7 xdir))
(> (abs (xdrx_points_area (cadr p2))) 0.0)
(xdrx_undostart)
(setq e1 (xdrx_polyline_make (xd::pnts:ucs2wcs (cadr p2)) t))
(progn (foreach n ents (_process e1 n))
(setq num (1+ num))
(setq ents (cons e1 ents)
ents-bak (cons e1 ents-bak)
ents (_clear ents)
)
(xdrx_entity_setproperty
ents
"constantwidth"
#xd_var_global_lw_width
"color"
#xd_var_global_ent_color
)
(xdrx_undoend)
(setq e1 nil)
)
)
t
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)

(defun c:XDTB_RectFree (/      e1     e2     el            ents   ents-bak 
                        info   info1  m_rec_ent            n           num 
                        p_1    p_2    p1     p2            ra           ss 
                        tmp    val    x             xdir 
                       ) 
  (defun _process (e1 e2) 
    (setq ra (xd::curve:relation e2 e1)) 
    (cond ((or (= ra 0) (= ra 4))) 
          ((or (= ra 2) (= ra 3)) (setq tmp (xdrx_get_union e1 e2))) 
          ((= ra 1) (setq tmp (xdrx_get_subtract e2 e1))) 
    ) 
    (if        tmp 
      (setq ents (append (xdrx_pickset->ents tmp) ents)) 
    ) 
    (xdrx_draworder->top 
      (setq ents (_clear (xd::list:removedup ents))) 
    ) 
  ) 
  (defun _clear        (el) 
    (setq el (vl-remove        nil 
                        (mapcar        '(lambda (x) 
                                   (if (and x (entget x)) 
                                     x 
                                   ) 
                                 ) 
                                el 
                        ) 
             ) 
    ) 
    (xdrx_polyline_compress el t) 
    el 
  ) 
  (xdrx_begin) 
  (if (not #xd_var_global_lw_width) 
    (setq #xd_var_global_lw_width 1.0) 
  ) 
  (if (not #xd_var_global_ent_color) 
    (setq #xd_var_global_ent_color 7) 
  ) 
  (setq        m_rec_ent nil 
        xdir          (getvar "ucsxdir") 
  ) 
  (xdrx_initssget "\n选取添加已有要处理的矩形<不选>:") 
  (setq ss (xdrx_ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1)))) 
  (setq        ents         (xdrx_pickset->ents ss) 
        ents-bak ents 
  ) 
  (setq num 0) 
  (while 
    (and (xd::doc:setosnap 547) 
         (if (> num 0) 
           (progn (setq info1 "/回退(U)") (xdrx_initget "A W C U")) 
           (progn (setq info1 "") (xdrx_initget "A W C")) 
         ) 
         (setq info (strcat "\n矩形第一点[设置轴(A)/宽度(W)/颜色(C)" 
                            info1 
                            "]<退出>:" 
                    ) 
         ) 
         (xdrx_prompt 
           "\n当前设置：线宽("             #xd_var_global_lw_width 
           ") 颜色("                     #xd_var_global_ent_color 
           ")" 
          ) 
         (setq p1 (getpoint info)) 
         (cond ((= p1 "W") 
                (if (setq val (getreal (xdrx_prompt 
                                         "\n输入线宽度<" 
                                         #xd_var_global_lw_width 
                                         ">:" 
                                         t 
                                       ) 
                              ) 
                    ) 
                  (progn (setq #xd_var_global_lw_width val) 
                         (xdrx_entity_setproperty 
                           ents 
                           "constantwidth" 
                           #xd_var_global_lw_width 
                         ) 
                  ) 
                ) 
                t 
               ) 
               ((= p1 "C") 
                (setq #xd_var_global_ent_color 
                       (acad_colordlg 
                         #xd_var_global_ent_color 
                       ) 
                ) 
                (xdrx_entity_setproperty 
                  ents 
                  "color" 
                  #xd_var_global_ent_color 
                ) 
                t 
               ) 
               ((= p1 "U") 
                (if (/= num 0) 
                  (progn (vl-cmdf "undo" 2) 
                         (setq num (1- num)) 
                         (setq ents (_clear ents-bak)) 
                         (if (= num 0) 
                           (princ "\r所有操作已经回退完毕！") 
                         ) 
                  ) 
                ) 
                t 
               ) 
               ((= p1 "A") 
                (if (and (setq p_1 (getpoint "\n轴线第一点<退出>:")) 
                         (setq p_2 (getpoint p_1 "\n轴线第二点<退出>:")) 
                    ) 
                  (progn (setq xdir (xdrx_vector_normalize 
                                      (mapcar '- (trans p_2 1 0) (trans p_1 1 0)) 
                                    ) 
                               xdir (if        (minusp (car xdir)) 
                                      (setq xdir (xdrx_vector_negate xdir)) 
                                      xdir 
                                    ) 
                         ) 
                  ) 
                ) 
                t 
               ) 
               ((= (type p1) 'LIST) t) 
         ) 
         (progn 
           (and        (= (type p1) 'LIST) 
                (setq p2 (xd::doc:getcorner p1 "\r矩形第二点<退出>:" 7 xdir)) 
                (> (abs (xdrx_points_area (cadr p2))) 0.0) 
                (xdrx_undostart) 
                (setq e1 (xdrx_polyline_make (xd::pnts:ucs2wcs (cadr p2)) t)) 
                (progn (foreach n ents (_process e1 n)) 
                       (setq num (1+ num)) 
                       (setq ents     (cons e1 ents) 
                             ents-bak (cons e1 ents-bak) 
                             ents     (_clear ents) 
                       ) 
                       (xdrx_entity_setproperty 
                         ents 
                         "constantwidth" 
                         #xd_var_global_lw_width 
                         "color" 
                         #xd_var_global_ent_color 
                        ) 
                       (xdrx_undoend) 
                       (setq e1 nil) 
                ) 
           ) 
           t 
         ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
  (princ) 
)

huangpc27 · 发表于 2018-8-31 10:38:41

很厉害的程序

AK95668 · 发表于 2018-9-4 14:56:25

很牛X的程序，用什么语言写的？我也要学编程

江南十笑 · 发表于 2018-9-6 19:23:12

命令加载不了

newer · 发表于 2018-9-6 20:40:33

江南十笑发表于 2018-9-6 19:23
命令加载不了

加载不了，说明你得多在论坛看看帖子

tzfcn · 发表于 2018-9-6 20:56:15

这个代码的功能相当好！

江南十笑 · 发表于 2018-9-6 21:40:08

newer 发表于 2018-9-6 20:40
加载不了，说明你得多在论坛看看帖子

第二版的我都能用第三版就不行我的XDRX API是20180905版本的求解答

newer · 发表于 2018-9-6 21:49:10

江南十笑发表于 2018-9-6 21:40
第二版的我都能用第三版就不行我的XDRX API是20180905版本的求解答

你加载不了，和什么版本的API没关系，肯定是你没拷贝和保存好代码

搜狗截图20180906214810.png

kqqt6236 · 发表于 2018-9-7 00:04:11

这功能太牛逼了。

江南十笑 · 发表于 2018-9-7 10:58:09

我看到的咋和你贴出来的不一样呢？

newer · 发表于 2018-9-7 11:07:00

江南十笑发表于 2018-9-7 10:58
我看到的咋和你贴出来的不一样呢？

哪地方不一样了，我就是从帖子拷贝的

你用鼠标全选中，按CTRL+C
搜狗截图20180907110603.png

alnhny · 发表于 2018-11-24 02:45:51

在这张图中有些怪问题，主要是改变轴后。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:12#.rar
下载次数:0 文件大小:1.67 MB
下载权限: 不限以上 [免费赚D豆]

XDSoft · 发表于 2018-11-24 12:08:48

alnhny 发表于 2018-11-24 02:45
在这张图中有些怪问题，主要是改变轴后。

去更新通用LISP函数库，解压拷贝到SYS目录覆盖

http://bbs.xdcad.net/thread-669133-1-1.html

再试试

alnhny · 发表于 2018-11-24 13:55:10

XDSoft 发表于 2018-11-24 12:08
去更新通用LISP函数库，解压拷贝到SYS目录覆盖

http://bbs.xdcad.net/thread-669133-1-1.html

更新后试了，不行，在这张图中只有轴方向为±X时才正常，其它方向画出的矩形都不对。

家辉 · 发表于 2020-2-8 15:26:31

命令加载不了、第一版、第二版都没问题、第三版提示代码有错误

账号		自动登录	找回密码
密码			立即注册

[矩形] 自由矩形（第三版）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评