[求助]：自己写的直线变圆弧代码的问题

sailorjt · 发表于 2006-12-14 18:52:58

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

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

×

lsp新手，对lsp很感兴趣，一个学习编写时常常会遇到问题，特此求教大家。
下面的代码是将直线改为圆弧。思路是取一直线两端点PT1，PT2，直线的旋转角；然后以PT1为端点，直线旋转角的顺时针22.5度为参考角度，以直线长度一半作为距离的定位点PO，最后圆弧以PT1,PO,PT2为点作出，并且删除原直线。

[FONT=courier new]
(defun c:qx (/ ss m k s1 edata etype pt1 px1 py1 pt2 px2 py2 D ang po)
;先计算直线旋转角度，再以直线一端点为基点，旋转角的-22.5度，1/2的直线长度为距离定位的点，作为圆弧的第二点.
(prompt "\n请选择需变圆弧的直线:")
(setq ss (ssget)
m 0
k 0
)
(repeat (sslength ss)
(setq s1 (ssname ss m))
(setq edata (entget s1)
etype (cdr (assoc 0 edata))
)
(if (= etype "LINE")
(progn
(setq pt1 (cdr (assoc 10 edata))
px1 (car pt1)
py1 (cadr pt1)
pt2 (cdr (assoc 11 edata))
px2 (car pt2)
py2 (cadr pt2)
D (/ (sqrt
(+ (* (- px1 px2) (- px1 px2)) (* (- py1 py2) (- py1 py2)))
)
2
)
)
(if (= px1 px2)
(progn (setq ang (- (/ pi 2) (/ pi 8)))
;画直线时只能由左往右画
(setq po (polar pt1 ang D))
)
(progn
(if (= py1 py2)
(progn (setq ang (- (* pi 2) (/ pi 8)))
;画直线时只能由下往上画
(setq po (polar pt1 ang D))
)
(progn
(setq ang
(- (atan (/ (- py1 py2) (- px1 px2))) (/ pi 8))
)
(if (< ang 0)
(setq ang (+ ang (* pi 2)))
)
(setq po (polar pt1 ang D))
)
)
)
)
(setq k
(1+ k)
)
(setq m
(1+ m)
)
(command "arc" pt1 po pt2)
(command "erase" s1 "")
)
)
)
(princ (strcat "\n共有<" (itoa k) ">根直线变圆弧了"))
(prin1)
)
[/FONT]

[FONT=courier new] 
(defun c:qx (/ ss m k s1 edata etype pt1 px1 py1 pt2 px2 py2 D ang po) 
   ;先计算直线旋转角度，再以直线一端点为基点，旋转角的-22.5度，1/2的直线长度为距离定位的点，作为圆弧的第二点. 
  (prompt "\n请选择需变圆弧的直线:") 
  (setq        ss (ssget) 
        m  0 
        k  0 
  ) 
  (repeat (sslength ss) 
    (setq s1 (ssname ss m)) 
 
    (setq edata        (entget s1) 
          etype        (cdr (assoc 0 edata)) 
    ) 
    (if        (= etype "LINE") 
      (progn 
        (setq pt1 (cdr (assoc 10 edata)) 
              px1 (car pt1) 
              py1 (cadr pt1) 
              pt2 (cdr (assoc 11 edata)) 
              px2 (car pt2) 
              py2 (cadr pt2) 
              D                  (/ (sqrt 
                       (+ (* (- px1 px2) (- px1 px2)) (* (- py1 py2) (- py1 py2))) 
                     ) 
                     2 
                  ) 
        ) 
        (if (= px1 px2) 
          (progn (setq ang (- (/ pi 2) (/ pi 8))) 
                                        ;画直线时只能由左往右画 
                 (setq po (polar pt1 ang D)) 
 
          ) 
          (progn 
            (if        (= py1 py2) 
              (progn (setq ang (- (* pi 2) (/ pi 8))) 
                                        ;画直线时只能由下往上画 
                     (setq po (polar pt1 ang D)) 
 
              ) 
              (progn 
 
                (setq ang 
                       (- (atan (/ (- py1 py2) (- px1 px2))) (/ pi 8)) 
                ) 
                (if (< ang 0) 
                  (setq ang (+ ang (* pi 2))) 
                ) 
                (setq po (polar pt1 ang D)) 
 
              ) 
            ) 
          ) 
        ) 
        (setq k 
               (1+ k) 
        ) 
        (setq m 
               (1+ m) 
        ) 
 
        (command "arc" pt1 po pt2) 
        (command "erase" s1 "") 
      ) 
    ) 
  ) 
  (princ (strcat "\n共有<" (itoa k) ">根直线变圆弧了")) 
  (prin1) 
) 
 
  [/FONT]

在运行时，代码时而好使，时而不灵，搞不清楚为什么。对于同一根直线，有时在试了四五次后才成功，搞不清楚到底是什么问题。（我在其它的代码里也遇到过类似的问题）。
在失败的几次了，提示“函数取消”，调试监视了各变量，没发现什么问题，直到“ (command "arc" pt1 po pt2) ”才跳出“函数取消
”，是什么原因导致函数取消？
由于这个在我工作中马上要用，所以编的比较粗，考虑的条件也不够全，只是想实用可以了。

zml84 · 发表于 2006-12-15 11:54:44

问题出在(setq m (1+ m))一句的位置不对。
详见下面的注释：

[FONT=courier new]
(defun c:qx (/ ss m k s1 edata etype pt1 px1 py1 pt2 px2 py2 D ang po)
;先计算直线旋转角度，再以直线一端点为基点，旋转角的-22.5度，1/2的直线长度为距离定位的点，作为圆弧的第二点.
(prompt "\n请选择需变圆弧的直线:")
(setq ss (ssget)
m 0
k 0
)
(repeat (sslength ss)
(setq s1 (ssname ss m))
(setq edata (entget s1)
etype (cdr (assoc 0 edata))
)
(if (= etype "LINE")
(progn
(setq pt1 (cdr (assoc 10 edata))
px1 (car pt1)
py1 (cadr pt1)
pt2 (cdr (assoc 11 edata))
px2 (car pt2)
py2 (cadr pt2)
D (/ (sqrt
(+ (* (- px1 px2) (- px1 px2))
(* (- py1 py2) (- py1 py2))
)
)
2
)
)
(if (= px1 px2)
(progn (setq ang (- (/ pi 2) (/ pi 8)))
;画直线时只能由左往右画
(setq po (polar pt1 ang D))
)
(progn
(if (= py1 py2)
(progn (setq ang (- (* pi 2) (/ pi 8)))
;画直线时只能由下往上画
(setq po (polar pt1 ang D))
)
(progn
(setq ang
(- (atan (/ (- py1 py2) (- px1 px2))
)
(/ pi 8)
)
)
(if (< ang 0)
(setq ang (+ ang (* pi 2)))
)
(setq po (polar pt1 ang D))
)
)
)
)
(setq k
(1+ k)
)
;;; (setq m ;;;★★注意此处。若当前实体不是直线，则执行不到这一句。
;;; (1+ m);;;★★显然与设计意图不符。
;;; )
(command "arc" pt1 po pt2)
(command "erase" s1 "")
)
)
(setq m (1+ m));;;★★注意此处，m序号变量m应在此处循环。
)
(princ (strcat "\n共有<" (itoa k) ">根直线变圆弧了"))
(prin1)
)
[/FONT]

[FONT=courier new] 
(defun c:qx (/ ss m k s1 edata etype pt1 px1 py1 pt2 px2 py2 D ang po) 
        ;先计算直线旋转角度，再以直线一端点为基点，旋转角的-22.5度，1/2的直线长度为距离定位的点，作为圆弧的第二点. 
    (prompt "\n请选择需变圆弧的直线:") 
    (setq ss (ssget) 
          m  0 
          k  0 
    ) 
    (repeat (sslength ss) 
        (setq s1 (ssname ss m)) 
 
        (setq edata (entget s1) 
              etype (cdr (assoc 0 edata)) 
        ) 
        (if (= etype "LINE") 
            (progn 
                (setq pt1 (cdr (assoc 10 edata)) 
                      px1 (car pt1) 
                      py1 (cadr pt1) 
                      pt2 (cdr (assoc 11 edata)) 
                      px2 (car pt2) 
                      py2 (cadr pt2) 
                      D          (/ (sqrt 
                                 (+ (* (- px1 px2) (- px1 px2)) 
                                    (* (- py1 py2) (- py1 py2)) 
                                 ) 
                             ) 
                             2 
                          ) 
                ) 
                (if (= px1 px2) 
                    (progn (setq ang (- (/ pi 2) (/ pi 8))) 
                                        ;画直线时只能由左往右画 
                           (setq po (polar pt1 ang D)) 
 
                    ) 
                    (progn 
                        (if (= py1 py2) 
                            (progn (setq ang (- (* pi 2) (/ pi 8))) 
                                        ;画直线时只能由下往上画 
                                   (setq po (polar pt1 ang D)) 
 
                            ) 
                            (progn 
 
                                (setq ang 
                                         (- (atan (/ (- py1 py2) (- px1 px2)) 
                                            ) 
                                            (/ pi 8) 
                                         ) 
                                ) 
                                (if (< ang 0) 
                                    (setq ang (+ ang (* pi 2))) 
                                ) 
                                (setq po (polar pt1 ang D)) 
 
                            ) 
                        ) 
                    ) 
                ) 
                (setq k 
                         (1+ k) 
                ) 
;;;                (setq m        ;;;★★注意此处。若当前实体不是直线，则执行不到这一句。 
;;;                         (1+ m);;;★★显然与设计意图不符。 
;;;                ) 
 
                (command "arc" pt1 po pt2) 
                (command "erase" s1 "") 
            ) 
        ) 
        (setq m (1+ m));;;★★注意此处，m序号变量m应在此处循环。 
    ) 
    (princ (strcat "\n共有<" (itoa k) ">根直线变圆弧了")) 
    (prin1) 
) 
  [/FONT]

另外：
1.求两点距离可用distance函数；
2.那个-22.5的角度，可以作为变量放在头部，可以增强程序的可读性。
3.对直线方向限制太死，造成通用性差。可以通过交换坐标将不同情况同一化。

sailorjt · 发表于 2006-12-15 17:08:52

谢谢。
昨晚我又改了一下，是取直线段中点，然后垂直于直线的下方，距离由用户输入，作为PO点。
刚刚在明经上有人说了时灵时不灵的原因，是osmode系统变量的原因。
不过还是没搞清楚osmode系统变量与圆弧被取消的联系。

自己画图时，任意三点都可以画出圆弧啊。

另外，还以其它的命令跟锁点有关联吗？

zml84 · 发表于 2006-12-16 08:43:12

在二楼我已经说的很清楚了，问题出在选择集内实体序号变量m的累计有问题。
你的思路是m中存储当前要分析的实体序号，K中存储已操作成功的实体个数；
那么就要不论是否操作成功都要累计，而你在一楼的代码是有问题的；其现象是在选择集内遍历实体时，当遇到非line对象时，其后的对象就都不分析了。
要做验证，你可以在选择对象时：
验证1、先选择一个非line对象，再选择line对象，执行结果是一个也执行不成；
验证2、先选择几个line对象，再选择非line对象，选择line对象，执行结果是仅能执行成果先选择的几个line对象。

sailorjt · 发表于 2006-12-16 12:02:45

谢谢zm184。
在二楼m的累计问题修正后，还是出现了时灵时不灵的问题。甚至于对单个图园都重复几次后才会灵。
有人说是跟osmode系统变量的原因。
现在osmode系统变量与圆弧被取消的联系，以及其它的CAD命令与此系统变量的关系。

zml84 · 发表于 2006-12-16 13:29:09

一、关于OSMODE[/COLOR]
OSMODE是系统变量，其存放的是当前对象捕捉模式。

这是CAD比较怪异的地方。
应该来说，在用lisp已坐标点对指定点位时，CAD应该可以分清这不是在用定点设备在屏幕上交互指定。（感谢KOHI在9楼的提醒，现更正。06-12-18 08:40）
但遗憾的是，CAD依然按照所设置的当前捕捉模式去定点。这是我们所不愿看到的。

到目前为止，在CAD做出修改之前，要避免这种情况的方法一般是：
1.在代码头部记录当前捕捉模式并将对象捕捉关闭；
2.代码主体；
3.在尾部恢复对象捕捉模式。

关于系统变量，要是不想翻书的话，请参阅：
http://www.zml84.blog.sohu.com/14144863.html

二、关于“错误：函数被取消”[/COLOR]
在需要点位响应命令时，已一个返回值不是点位数据的LISP表去交互，则会发生该种错误。见下图：

登录/注册后可看大图

你所说的执行到“（command "_arc" ...... ）”一句出现错误，事实上是由于前一个实体的操作尚未执行完，而又向CAD命令行发送这一条的命令所致。

sailorjt · 发表于 2006-12-16 18:39:26

谢谢LS热情详细的解答。

xyp1964 · 发表于 2006-12-17 20:38:22

有点复杂了！

[FONT=courier new](defun c:test ()
(setvar "osmode" 0)
(setq ss (ssget '((0 . "LINE")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt10 (cdr (assoc 10 (entget s1)))
pt11 (cdr (assoc 11 (entget s1)))
rad (- (angle pt10 pt11) (/ pi 4))
pt0 (polar pt10 rad (/ (distance pt10 pt11) 2.0))
)
(command "arc" pt10 pt0 pt11)
(entdel s1)
)
(princ (strcat "\n共有<" (itoa i) ">根直线变圆弧了"))
(princ)
)[/FONT]

kohi · 发表于 2006-12-18 02:37:55

与二楼商权：关于“用lisp交互指定点位“
这是因为交点附近可能有“中点“ 或 “象限点“--所以“CAD依然按照所设置的当前捕捉模式去定点“。

tdgc · 发表于 2006-12-18 18:34:43

按二楼的去做加载程序时出现" 错误: 参数类型错误: numberp: nil",不知道为什么,按8楼的去做就正确了

sailorjt · 发表于 2006-12-19 18:29:38

8楼斑主，我在开头加了“  (setq osm (getvar "osmode"))
  (setvar "osmode" 0) ”
末尾“ (setvar "osmode" osm)  ”
以来保存捕捉设置。
可是如果中途回车退出，针对你的程序，怎么改？

zml84 · 发表于 2006-12-23 19:52:26

致sailorjt：
一、程序中途退出问题，通过自定义错误函数可以很好的解决。

例如添加下面的代码：

;;;自定义错误处理函数,那么在出错退出时就会执行。
;;;在这里，可以写入要恢复的系统变量等工作，使程序干净退出。
(defun *error* (msg)
(princ "MY错误：")
(princ msg)
(if (/= osm nil)
(progn (princ "\n捕捉系统变量已恢复为：")
(princ (setvar "osmode" osm))
)
)
(princ)
)

要注意的是变量osm不能再做为qx函数的局部变量使用了，需要把它从你的qx函数局部变量列表中拿掉。

二、另外你于2006-12-20 18:40通过邮件发给我的代码，冒昧先粘贴于下面。
其中有几处尚能改进得更加完美，让我们共同探讨。

(defun c:qx (/ osm d f ss i s1 pt1 px1 py1 pt2 px2 py2 pt3 px3 py3 ang
ang1 pt0)
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq d (getreal "\n请输入圆弧偏移距离<150>:"))
(if (= d nil)
(setq d 150)
)
(initget "u d")
(setq f (getkword "\n请输入圆弧偏移方向:上(u)或下(d):<d>"))
(if (= f nil)
(setq f "d")
)
(setq ss (ssget '((0 . "LINE")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq pt1 (cdr (assoc 10 (entget s1)))
pt2 (cdr (assoc 11 (entget s1)))
px1 (car pt1)
py1 (cadr pt1)
px2 (car pt2)
py2 (cadr pt2)
px3 (/ (+ px1 px2) 2)
py3 (/ (+ py1 py2) 2)
pt3 (list px3 py3 0)
ang (angle pt1 pt2)
)
(if (or (< ang (/ pi 2))
(> ang (/ (* pi 3) 2))
(= ang (/ pi 2))
)
(progn (setq ang1 (- ang (/ pi 2)))
(if (< ang1 0)
(setq ang1 (+ ang1 (* pi 2)))
)
(if (= f "d")
(setq pt0 (polar pt3 ang1 d))
(setq pt0 (polar pt3 ang1 (- 0 d)))
)
)
(progn (setq ang1 (+ ang (/ pi 2)))
(if (= f "d")
(setq pt0 (polar pt3 ang1 d))
(setq pt0 (polar pt3 ang1 (- 0 d)))
)
)
)
(command "arc" pt1 pt0 pt2)
(entdel s1)
)
(setvar "osmode" osm)
(princ (strcat "\n共有<" (itoa i) ">根直线变圆弧了"))
(princ)
)

(defun c:qx (/ osm d f ss i s1 pt1 px1 py1 pt2 px2 py2 pt3 px3 py3 ang 
             ang1 pt0) 
    (setq osm (getvar "osmode")) 
    (setvar "osmode" 0) 
    (setq d (getreal "\n请输入圆弧偏移距离<150>:")) 
    (if        (= d nil) 
        (setq d 150) 
    ) 
    (initget "u d") 
    (setq f (getkword "\n请输入圆弧偏移方向:上(u)或下(d):<d>")) 
    (if        (= f nil) 
        (setq f "d") 
    ) 
    (setq ss (ssget '((0 . "LINE"))) 
          i  -1 
    )    
    (while (setq s1 (ssname ss (setq i (1+ i)))) 
        (setq pt1 (cdr (assoc 10 (entget s1))) 
              pt2 (cdr (assoc 11 (entget s1))) 
              px1 (car pt1) 
              py1 (cadr pt1) 
              px2 (car pt2) 
              py2 (cadr pt2) 
              px3 (/ (+ px1 px2) 2) 
              py3 (/ (+ py1 py2) 2) 
              pt3 (list px3 py3 0) 
              ang (angle pt1 pt2) 
        ) 
        (if (or        (< ang (/ pi 2)) 
                (> ang (/ (* pi 3) 2)) 
                (= ang (/ pi 2)) 
            ) 
            (progn (setq ang1 (- ang (/ pi 2))) 
                   (if (< ang1 0) 
                       (setq ang1 (+ ang1 (* pi 2))) 
                   ) 
                   (if (= f "d") 
                       (setq pt0 (polar pt3 ang1 d)) 
                       (setq pt0 (polar pt3 ang1 (- 0 d))) 
                   ) 
            ) 
            (progn (setq ang1 (+ ang (/ pi 2))) 
                   (if (= f "d") 
                       (setq pt0 (polar pt3 ang1 d)) 
                       (setq pt0 (polar pt3 ang1 (- 0 d))) 
                   ) 
            ) 
        ) 
        (command "arc" pt1 pt0 pt2) 
        (entdel s1) 
    ) 
    (setvar "osmode" osm) 
    (princ (strcat "\n共有<" (itoa i) ">根直线变圆弧了")) 
    (princ) 
)

1. 我认为，对于圆弧偏移距离和方向参数在每次执行时均要求输入，太麻烦。
可以将其做为全局变量存储，做为下次执行时的默认值，提示用户予以确认，这样更方便使用。
2. 可以规定一下（比如上正下负），将距离和方向两个参数合并成为一个，尽量减少输入。
3. 对于不同倾角对象的处理，我还是坚持在前贴中提到的意见，即若对象方向不是规定方向时，直接交换PT1、PT2的坐标值后，即可统一处理。

当然“杀猪杀屁股，各有各的杀法”，这也正是LISP的宽容之处。

sailorjt · 发表于 2006-12-24 19:46:08

谢谢LS的优化方案。
现在的问题是，在用户UCS下运行代码就会出现偏移，需要将PT1 PT2 转化到用户UCS下。
在PT1 PT2 定义后加了
(setq pt1 (trans pt1 0 1)
pt2 (trans pt2 0 1))
但妈像不行啊，是什么问题？

zml84 · 发表于 2006-12-25 10:29:16

一、是这样的，entget得到的坐标是世界坐标系的。
而采用command命令时所要输入的坐标是相对于当前用户坐标系的。

若不想在各个坐标系中转换的话，建议使用entmod 替代COMMAND 函数。

二、如你上贴所言，在加上了
(setq pt1 (trans pt1 0 1)
pt2 (trans pt2 0 1))
两句之后，我测试了一下，是可以通过的。
你说的不行，是什么情况？

sailorjt · 发表于 2006-12-25 11:58:13

我用
(setq pt1 (trans pt1 0 1)
pt2 (trans pt2 0 1))
想世界坐标系转为用户坐标系，但是逐句运行，从监视窗口上看到，pt1,pt2的坐标没有变化。

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

[求助] [求助]：自己写的直线变圆弧代码的问题

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

相关帖子