[函数]这个程序怎么回事了lisp

lzy9788 · 发表于 2004-4-8 16:58:00

下面这个程序有什么问题
(defun c:ccb ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(princ "\n尺寸合并>.请选择要合并的尺寸:")
(setq ss1 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam1 (ssname ss1 0)
   ent1 (entget nam1)
   pdim1_13 (cdr (assoc 13 ent1))
   pdim1_14 (cdr (assoc 14 ent1)))
(setq ss2 (ssget ":s" '((0 . "DIMENSION"))))
(setq nam2 (ssname ss2 0)
   ent2 (entget nam2)
   pdim2_13 (cdr (assoc 13 ent2))
   pdim2_14 (cdr (assoc 14 ent2)))
(setq bb (list pdim1_13 pdim1_14 pdim2_13 pdim2_14))
(setq bb1
   (vl-sort bb
   (function (lambda (e1 e2)
   (< (car e1) (car e2)) ) ) )
);;end setq X坐标从小到大排序
(setq bb2
   (vl-sort bb
   (function (lambda (e1 e2)
   (< (cadr e1) (cadr e2)) ) ) )
);;end setq Y坐标从小到大排序
(setq ang1 (angle pdim1_13 pdim1_14))
(setq bbb (if (or (= ang1 0) (= ang1 pi)) bb1 bb2))
(setq ang2 (angle (nth 0 bbb) (nth 1 bbb))
        ang3 (angle (nth 0 bbb) (nth 3 bbb)))
(if (/= ang2 ang3)
   (princ "\n不在同一直线，尺寸不能合并!")
   (progn
   (setq ent1 (subst (cons 13 (nth 0 bbb)) (assoc 13 ent1) ent1))
   (setq ent1 (subst (cons 14 (nth 3 bbb)) (assoc 14 ent1) ent1))
   (entmod ent1)
   (command "erase" ss2 "")
   );end progn
);end if
(command "_.undo" "e")
(setvar "cmdecho" 1)
(princ));end defun
我去掉IF条件限制后又能用，即直接用下面的语句
   ……
   ……
   (setq ent1 (subst (cons 13 (nth 0 bbb)) (assoc 13 ent1) ent1))
   (setq ent1 (subst (cons 14 (nth 3 bbb)) (assoc 14 ent1) ent1))
   (entmod ent1)
   (command "erase" ss2 "")
(command "_.undo" "e")
(setvar "cmdecho" 1)
(princ));end defun

e2002 · 发表于 2004-4-8 17:17:00

个人感觉"尺寸合并"的需求在实际当中,与其费力写程序,用程序操作还不如删除不需要的那几个Dim,再Extend剩下的一个的方法高效.

用户使用是选择可能出现非常多种情况(不在同一直线上,根本就不相邻,根本就不平行....),程序要方方面面都考虑

总之,程序只是再命令交互没有好办法的情况下才去写的

lzy9788 · 发表于 2004-4-8 17:24:00

我是做建筑结构的，这个程序很方便的，只是这给定限制条件后
不正常，有些不明白，自己感觉没有什么错
我是通过判断是否在同一直线上（IF语句）
可现在上面的程序实现不了

[函数]这个程序怎么回事了lisp

发表回复

精选推荐