如何用对话框来控制四边形倒角

sicky111

怎么写一个带DCL的LISP程式，可以按照自己的需要给四边形的四个角倒角，如选择左上时，倒左上角；选择右下时，倒右下角。

XDSoft

楼主是想问怎么写DCL呢，还是怎么写这样要求的LISP？

sicky111

XDSoft 发表于 2013-5-13 01:12
楼主是想问怎么写DCL呢，还是怎么写这样要求的LISP？

不好意思，可能是我没表达清楚，我是想能不能做一个多段线（四边形）倒角的LISP程式，用DCL中的toggle去控制需要倒哪一个角？我不知道如何去判断四边形的四个角，哪个角是左上角，哪个角是右下角，以及左下和右上。

XDSoft

sicky111 发表于 2013-5-13 02:30
不好意思，可能是我没表达清楚，我是想能不能做一个多段线（四边形）倒角的LISP程式，用DCL中的toggle去 ...

为什么要DCL去判断，你点哪个就倒哪个啊。

给你个思路：

你用 entsel 点一个角附近，然后判断四边形的哪个顶点距离 entsel 的点近，哪个近你就倒哪个，不一定非要定到底是上下左右。

sicky111

XDSoft 发表于 2013-5-13 02:40
为什么要DCL去判断，你点哪个就倒哪个啊。

给你个思路：

谢谢管理员的回复，这么晚还和我一样没休息啊。我现在就纠结如何去判断四个角的方位，没有一点头绪，睡不着。我的想法是，如果能确定四个角的方位，当我想倒某一个角时，在DCL中选中那个角，然后entsel多段线，那个角就倒好了。我知道倒最近点的角，(command ".fillet" (osnap (cadr el1) "nea") (osnap (cadr el2) "nea") "")，但是我想要的不是这个。

XDSoft

不管你做了什么准备工作，最后你不总要是去用 entsel 去点实体吗？ 那为什么要搞的那么复杂呢，你想倒哪个就在哪个角的旁边点下不就得了？

除非你不用交互，比如批量倒很多四边形。

sicky111

管理员一语中的，我就是想实现批量倒某一个角。在DCL设置好要倒的角，然后框选一次就OK。

sicky111

换句话说，如果一个四边形，我要两个对角倒C角，另外两个对角倒R角，一般情况下，我要选8次，才能完成四个倒角；但是如果做一个DCL，我只需要选1次，就可完成四个倒角，简化了很多步骤，也节省时间。

st788796

1 端点必须是 4 个
2 求 MinX MinY 左下角点->Param
3 右下角点 1+ Param ,如果大于 3  则 (- 3 Param) -> vlax-curve-getpointatparam
4 依次求右上、左上点

zxq0220

给个半成品例子
[pcode=lisp,true];四角倒角 晓东 zxq0220 2013.5.13
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (> (setq dcl_id (load_dialog "dj")) 0) (progn
  (if (new_dialog "dj" dcl_id) (progn
   (tagdlg)
   (action_tile "zs" "(tagdlg)")
   (action_tile "ys" "(tagdlg)")
   (action_tile "zx" "(tagdlg)")
   (action_tile "yx" "(tagdlg)")
   (action_tile "accept" "(getdata)(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
   (setq re (start_dialog))
  )
   (princ "\n无法显示对话框！")
  )
  (unload_dialog dcl_id)
)
  (princ "\n无法加载对话框！")
)
(if (= re 1)
  (if (and (setq pt1 (getpoint "\n窗选第一角点: "))
           (setq pt2 (getcorner pt1 "\n窗选第二角点: "))) (progn
   (setq ss (ssget "W" pt1 pt2 '((0 . "LWPOLYLINE") (90 . 4))))
   (setq i -1)
   (repeat (sslength ss)
    (setq ptl (list))
    (setq ent (entget(ssname ss (setq i (1+ i)))))
    (foreach x ent (if (= (car x) 10) (setq ptl (cons (cdr x) ptl))))
    (setq xmin (apply 'min (mapcar 'car ptl)));x最小值
    (setq xmax (apply 'max (mapcar 'car ptl)));x最大值
    (setq ymin (apply 'min (mapcar 'cadr ptl)));y最小值
    (setq ymax (apply 'max (mapcar 'cadr ptl)));y最大值
    (setq pzs (list xmin ymax));左上
    (setq pys (list xmax ymax));右上
    (setq pzx (list xmin ymin));左下
    (setq pyx (list xmax ymin));右下
    (if (= zs "1") (progn
     (setq pm1 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzs pys))
     (setq pm2 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzs pzx))
     (if (= zsj "1")
      (command "_.FILLET" pm1 pm2)  ;倒圆角
      (command "_.CHAMFER" pm1 pm2)  ;倒角
     )
    ))
    (if (= ys "1") (progn
     (setq pm1 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzs pys))
     (setq pm2 (mapcar '(lambda (a b) (/ (+ a b) 2)) pys pyx))
     (if (= ysj "1")
      (command "_.FILLET" pm1 pm2)  ;倒圆角
      (command "_.CHAMFER" pm1 pm2)  ;倒角
     )
    ))
    (if (= zx "1") (progn
     (setq pm1 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzx pyx))
     (setq pm2 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzs pzx))
     (if (= zxj "1")
      (command "_.FILLET" pm1 pm2)  ;倒圆角
      (command "_.CHAMFER" pm1 pm2)  ;倒角
     )
    ))
    (if (= yx "1") (progn
     (setq pm1 (mapcar '(lambda (a b) (/ (+ a b) 2)) pys pyx))
     (setq pm2 (mapcar '(lambda (a b) (/ (+ a b) 2)) pzs pyx))
     (if (= yxj "1")
      (command "_.FILLET" pm1 pm2)  ;倒圆角
      (command "_.CHAMFER" pm1 pm2)  ;倒角
     )
    ))
   )
  ))
)
(setvar "CMDECHO" 1)
(princ)
)
(defun tagdlg ()
(mode_tile "yj1" (if (= (get_tile "zs") "1") 0 1))
(mode_tile "yj2" (if (= (get_tile "ys") "1") 0 1))
(mode_tile "yj3" (if (= (get_tile "zx") "1") 0 1))
(mode_tile "yj4" (if (= (get_tile "yx") "1") 0 1))
)
(defun getdata ()
(setq zs (get_tile "zs")
ys (get_tile "yx")
zx (get_tile "zx")
yx (get_tile "yx"))
(setq zsj (if (= zs "1") (get_tile "yj1") nil))
(setq ysj (if (= ys "1") (get_tile "yj2") nil))
(setq zxj (if (= zx "1") (get_tile "yj3") nil))
(setq ysj (if (= yx "1") (get_tile "yj4") nil))
)
[/pcode]

dcl_settings:default_dcl_settings {audit_level = 3;}
dj:dialog{
:row{
  :boxed_column{
   label="倒角方位";
   :toggle{label="左上角";key="zs";value="1";}
   :toggle{label="右上角";key="ys";}
   :toggle{label="左下角";key="zx";}
   :toggle{label="右下角";key="yx";}
  }
  :boxed_column{
   label="倒角类型";
   :toggle{label="倒圆角";key="yj1";}
   :toggle{label="倒圆角";key="yj2";}
   :toggle{label="倒圆角";key="yj3";}
   :toggle{label="倒圆角";key="yj4";}
  }
}
ok_cancel;
}

sicky111

zxq0220 发表于 2013-5-13 09:27
给个半成品例子
;四角倒角 晓东 zxq0220 2013.5.13
(defun c:tt ()

谢谢您的热心回复，还是不知道怎么判断四个角的方位。

zxq0220

10楼改了，但倒角大小要事先设好。

牢固

sicky111 发表于 2013-5-13 16:01
谢谢您的热心回复，还是不知道怎么判断四个角的方位。

四边形是可以任意角度放置的，要判断四个角属于哪个方位，首先你要明确给角点的方位下一个定义，你才可以写程序，否则，你如何判定？这样？

sicky111

牢固 发表于 2013-5-13 22:26
四边形是可以任意角度放置的，要判断四个角属于哪个方位，首先你要明确给角点的方位下一个定义，你才可以 ...

G版您好，我现在只考虑水平的四边形，不考虑带斜度的，如果有带斜度，可以先将四边形转正，倒完角后再旋转回去。

sicky111

zxq0220 发表于 2013-5-13 22:22
10楼改了，但倒角大小要事先设好。

非常感谢，但是测试还是有问题。错误: 参数类型错误: lselsetp nil
只有新开图档第一次默认倒左上角的R角时，可以正常倒R角；第二次再倒角时，程式出错。
如果第一次不是选择默认的左上角倒圆角，程式也会出错，不能正常倒角。