[求助]：编了一个Lisp程序，出了两个小问题，请高手指教一下！

ahill · 发表于 2007-3-29 11:48:27

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

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

×

因工作需要，编了一个小小的Lisp程序，程序的作用是自动标注房间封闭多义线的面积和周长，现在运行都正常，标注也正常，只是有两个地方不是很完善，想请高手指教一下！
先看一下源程序：

(DEFUN C:dda(/ bs aa per ptu ptd txth)
(
      (setvar "cmdecho" 0 )
      (princ "\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!")
      (princ "\n点取房间多义线:")
(setq bs (ssget))
(command "area" "o" bs)
(setq aa (getvar "area"))
(setq aa (/ aa 1000000.0))　　　
(setq aa (rtos aa 2 2))
      (setq aa (strcat "A=" aa))
      (setq aa (strcat aa "M2"))
      (setq per (getvar "perimeter"))
      (setq per (/ per 1000.0))　　　
      (setq per (rtos per 2 2))
      (setq per (strcat "P=" per))
      (setq per (strcat per "M"))
      (setq txth (* (getvar "hpscale") 2.5))
      (setq pt (getpoint "点取标注点:"))
      (setq ptu (list (car pt) (+ (cadr pt) (* txth 1)) 0.0))
      (setq ptd (list (car pt) (- (cadr pt) (* txth 1)) 0.0))
      (command "text" "j" "mc" ptu txth "0" aa)
      (command "text" "j" "mc" ptd txth "0" per)
      (command "erase" bs "")
      (setvar "cmdecho" 1)
      (princ )
  )
)

现在我认为的两个小问题是：
1、在运行完成后屏幕最后提示　函数错误: 0　，我想这个意思应该是说偶的程序是正确运行了的（惭愧，第一次学习编写Lisp，居然就正确了），这个应该是最后的返回码，现在的问题，我不想看到这个提示，应该如何修改？
2、 (setq ptu (list (car pt) (+ (cadr pt) (* txth 1)) 0.0))
      (setq ptd (list (car pt) (- (cadr pt) (* txth 1)) 0.0))
请注意这两句里的 (* txth 1)，原设计意思是想对面积和周长的标注进行以所点取点为中心放置时的位置调整，这里的问题是，那个1为什么不能被改成小数，我的本意是想设置为0.6的，这样子标注出的两行字应该会紧凑一些，但是这里一改为小数就会错位，达不到我想要的效果，请问一下这是为什么？是不是我的CAD有问题？
反复试验的结果是有时是正确的，有时又是错误的。。郁闷。。搞不懂到底是怎么一回事？

请高手不吝指正一下下。。。谢过先。

zml84 · 发表于 2007-3-29 20:43:00

一.关于问题一
你的代码结构是这样的：
[PHP]
(DEFUN C:dda (/ bs aa per ptu ptd txth)
(
(setvar "cmdecho" 0)
...
...
)
)
[/PHP]
(setvar "cmdecho" 0)　返回值是0，其上一层则执行 (0 ...)
根据LISP语言特性，表结构的第一个元素为函数名，例如 (+ 1 2) 、 (* 2 3 4)等．
而在这里，要去执行0这个函数，解释器是找不到0这个函数的，故有"函数错误: 0　".
解决方法：去掉一队括号，将结构变为:
[PHP]
(DEFUN C:dda (/ bs aa per ptu ptd txth)
(setvar "cmdecho" 0)
...
...
)
[/PHP]
二.关于问题二，你的想法是正确的，完全可以将其改成任何小数．
 
整个程序代码修改后，如下：

(DEFUN C:dda (/ bs aa per ptu ptd txth)
(setvar "cmdecho" 0)
(princ
"\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!"
)
;; (princ "\n点取房间多义线:")
;; (setq bs (ssget))
(if (setq bs (entsel "\n点取房间多义线:"))
(progn
(command "_area" "o" bs)
(setq aa (getvar "area"))
(setq aa (/ aa 1000000.0))
　　　
(setq aa (rtos aa 2 2))
;;(setq aa (strcat "A=" aa))
;;(setq aa (strcat aa "M2"))
(setq aa (strcat "A=" aa "㎡"))
(setq per (getvar "perimeter"))
(setq per (/ per 1000.0))
　　　
(setq per (rtos per 2 2))
;;(setq per (strcat "P=" per))
;;(setq per (strcat per "M"))
(setq per (strcat "P=" per "m"))
(setq txth (* (getvar "hpscale") 2.5))
(if (setq pt (getpoint "\n点取标注点:"))
(progn
;;(setq ptu (list (car pt) (+ (cadr pt) (* txth 0.6)) 0.0))
;;(setq ptd (list (car pt) (- (cadr pt) (* txth 0.6)) 0.0))
(setq ptu (polar pt (* 0.5 pi) (* txth 0.6))
ptd (polar pt (* 1.5 pi) (* txth 0.6))
)
(command "text" "j" "mc" ptu txth "0" aa)
(command "text" "j" "mc" ptd txth "0" per)
(command "erase" bs "")
)
)
)
)
(setvar "cmdecho" 1)
(princ)
)

(DEFUN C:dda (/ bs aa per ptu ptd txth) 
    (setvar "cmdecho" 0) 
    (princ 
        "\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!" 
    ) 
    ;;        (princ "\n点取房间多义线:") 
    ;;        (setq bs (ssget)) 
    (if        (setq bs (entsel "\n点取房间多义线:")) 
        (progn 
            (command "_area" "o" bs) 
            (setq aa (getvar "area")) 
            (setq aa (/ aa 1000000.0)) 
            　　　 
            (setq aa (rtos aa 2 2)) 
            ;;(setq aa (strcat "A=" aa)) 
            ;;(setq aa (strcat aa "M2")) 
            (setq aa (strcat "A=" aa "㎡")) 
 
            (setq per (getvar "perimeter")) 
            (setq per (/ per 1000.0)) 
            　　　 
            (setq per (rtos per 2 2)) 
            ;;(setq per (strcat "P=" per)) 
            ;;(setq per (strcat per "M")) 
            (setq per (strcat "P=" per "m")) 
 
            (setq txth (* (getvar "hpscale") 2.5)) 
            (if        (setq pt (getpoint "\n点取标注点:")) 
                (progn 
                    ;;(setq ptu (list (car pt) (+ (cadr pt) (* txth 0.6)) 0.0)) 
                    ;;(setq ptd (list (car pt) (- (cadr pt) (* txth 0.6)) 0.0)) 
                    (setq ptu (polar pt (* 0.5 pi) (* txth 0.6)) 
                          ptd (polar pt (* 1.5 pi) (* txth 0.6)) 
                    ) 
                    (command "text" "j" "mc" ptu txth "0" aa) 
                    (command "text" "j" "mc" ptd txth "0" per) 
                    (command "erase" bs "") 
                ) 
            ) 
        ) 
    ) 
    (setvar "cmdecho" 1) 
    (princ) 
)

另：1. 我一向认为，好的程序应该在结构上避免用户输入的不合法性．所以在上面的代码中使用了 if 语句，使得了用户右键空响应时能够安全退出．
2.strcat 函数可以接受多个参数，所以可以将
[PHP]
;;(setq aa (strcat "A=" aa))
;;(setq aa (strcat aa "M2"))
;;===合并为====>>>>>
(setq aa (strcat "A=" aa "M2"))
[/PHP]
3.在计算点位坐标时，使用 polar 函数能使计算简化．

szx025 · 发表于 2007-3-30 07:40:38

程序写得不错,能否再加如面积总计的内容

hsslyl · 发表于 2007-3-30 08:37:28

按以下修改试试
(command "text" "j" "mc" "non" ptu txth "0" aa)
(command "text" "j" "mc" "non" ptd txth "0" per)

ahill · 发表于 2007-3-30 10:50:19

最初由 zml84 发布
[B]一.关于问题一
你的代码结构是这样的：
[PHP]
(DEFUN C:dda (/ bs aa per ptu ptd txth)
(
(setvar "cmdecho" 0)
...
...
)
)
[/PHP]
(setvar "cmdecho" 0)　返回值是0，其上一层则执... [/B]

明白，谢谢指教！十分感谢！

因为我这是第一次学习Lisp，关于各函数的用法并不是特别清楚，这些高级技巧更是无人指导，纯粹是自己一个人在这里胡搞瞎搞，谢谢你给我指明了一些学习的方向。

再次感谢。

------------------------------------------------------------------------

最新进展：

如何才解释下面这个现象？

命令: dda
说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!
点取房间多义线:
点取标注点:
Txth=187.5
Pt=(-40436.2 258.83 0.0)
Ptu=(-40436.2 371.33 0.0)
Ptd=(-40436.2 146.33 0.0)
Ptu2=(-40436.2 371.33 0.0)
Ptd2=(-40436.2 146.33 0.0)

命令:
命令: li LIST 找到 1 个

               TEXT    图层: 0
                        空间: 模型空间
               句柄 = 24f
         样式 = "图框－黑体"
            字体 = 黑体
            中央点， X= -40979  Y=    278  Z=       0
            高度    188
            文字 P=43.24m
            旋转角度    0
            宽度比例因子       1
            倾斜角度    0
            生成普通

下面的这个中心点的座标原则上应该是跟上面的Ptd保持一致的。。但是这里为什么会不一样呢？

进程跟踪的结果证明Ptd 和 Ptd2的座标是一致的，但是为什么在用了

(command "text" "j" "mc" ptu txth "0" aa)
(command "text" "j" "mc" ptd txth "0" per)

这两行命令时第二次的 ptd 定位点为什么实际不一样呢？

困惑中。。。。

请指教。。

zml84 · 发表于 2007-3-30 16:14:08

把你的完整代码发上来吧。

ahill · 发表于 2007-3-31 09:34:33

请看一下，这个是我的调试时的完整代码。（这只是一个独立功能的小程序，并不会嵌入到某一个系统里。）

;本程序适用于建筑类图纸经常需要标注房间的室内面积和周长时所用。
;在使用本程序前请先使用CAD的绘图命令生成各房间的封闭的多义线。
;本程序默认原绘图单位为MM。

(DEFUN C:dda (/ bs aa per ptu ptd txth)
   (setvar "cmdecho" 0)
   (princ"\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!" )
(if
(setq bs (entsel "\n点取房间多义线:"))
(progn
      (command "_area" "o" bs)

      (setq aa (strcat "A=" (rtos (/ (getvar "area") 1000000.0) 2 2) "㎡"))
      (setq per (strcat "P=" (rtos (/ (getvar "perimeter") 1000.0) 2 2) "m"))

      (setq txth (* (getvar "hpscale") 2.5))
      (if (setq pt (getpoint "\n点取标注点:"))
(progn
                  (setq ptu (polar pt (* 0.5 pi) (* txth 0.6))
   ptd (polar pt (* 1.5 pi) (* txth 0.6))
      )

(princ "\n Txth=")(princ Txth) ;进程跟踪，观察参数变化，最终可删除。
(princ "\n Pt=")(princ pt)    ;进程跟踪，观察参数变化，最终可删除。
(princ "\nPtu=")(princ ptu)    ;进程跟踪，观察参数变化，最终可删除。
(princ "\nPtd=")(princ ptd)    ;进程跟踪，观察参数变化，最终可删除。

      (command "text" "j" "mc" ptu txth "0" aa)
      (command "text" "j" "mc" ptd txth "0" per)
(princ "\nPtu2=")(princ ptu)    ;进程跟踪，观察参数变化，最终可删除。
(princ "\nPtd2=")(princ ptd)    ;进程跟踪，观察参数变化，最终可删除。

   ; (command "erase" bs "")
)
      )
)
)
(setvar "cmdecho" 1)
(princ)
)

你可以先在CAD中画一个矩形，然后调用这个LSP，DDA一个，在矩形中间点一下，结果就看得很清楚的。

困惑啊，从程序分析的过程来看这个应该是没有问题的呀。

　*　*　*　*　*　*　*　*　*　*　*

刚才调试，无意中发现了一个现象，就是当矩形比较小并且在屏幕上显示得比较大的时候，标注就是正确的，但是当我把屏显缩小一些，让该矩形在屏幕上看上去比较小的时候，那个标注就是错开的，而且当我定义标注点为矩形的一个角点的时候，两行标注居然重合了，就是下图中矩形右下角的那个地方。。。奇哉怪也。。。。

ahill · 发表于 2007-3-31 10:07:22

最初由 hsslyl 发布
[B]按以下修改试试
(command "text" "j" "mc" "non" ptu txth "0" aa)
(command "text" "j" "mc" "non" ptd txth "0" per) [/B]

按你的这个方法，加了 "non" 　后成功了，佩服ING。。。但是能否想请你解释一个这个选项为什么要加在这儿？

zml84 · 发表于 2007-4-4 13:57:26

是捕捉设置的问题啊，
一般来说，在COMMAND函数中使用点位坐标是，系统会按照当前的捕捉设置进行捕捉。
这显然是不正确的，然而ACAD就是这么设计的。我们只有在程序中把捕捉关掉来解决这个问题。
 
所以有了"non"

szx025 · 发表于 2007-4-4 14:23:04

接着上面的问题,
为什么我在程序中加了(setvar "OSMODE" 0),还会出现画线时捕捉到其它的点

zml84 · 发表于 2007-4-4 17:53:32

没有问题的，如下：：

(DEFUN C:dda (/ bs aa per ptu ptd txth)
(setvar "cmdecho" 0)
(princ
"\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!"
)
(setq sum 0
i 0
)
(while (if (setq bs (entsel "\n点取房间多义线:"))
(if (setq pt (getpoint ">>>点取标注点:"))
T
nil
)
nil
)
(command "_area" "o" bs)
(setq aa (getvar "area"))
(setq aa (/ aa 1000000.0))
(setq str-aa (strcat "A=" (rtos aa 2 2) "㎡"))
(setq per (getvar "perimeter"))
(setq per (/ per 1000.0))
　　　
(setq str-per (strcat "P=" (rtos per 2 2) "m"))
(setq txth (* (getvar "hpscale") 2.5))
(setq ptu (polar pt (* 0.5 pi) (* txth 0.6))
ptd (polar pt (* 1.5 pi) (* txth 0.6))
)
;;设置捕捉
(setq os_old (getvar "osmode"))
(setvar "osmode" 0)
;;写文字
(command "text" "j" "mc" ptu txth "0" str-aa)
(command "text" "j" "mc" ptd txth "0" str-per)
(command "erase" bs "")
;;恢复捕捉设置
(setvar "osmode" os_old)
;;面积累计
(setq sum (+ aa sum)
i (1+ i)
)
(princ (strcat ">>>第 "
(itoa i)
" 次，面积累计："
(rtos sum 2 2)
"㎡"
)
)
)
(setvar "cmdecho" 1)
(princ)
)

(DEFUN C:dda (/ bs aa per ptu ptd txth) 
    (setvar "cmdecho" 0) 
    (princ 
        "\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!" 
    ) 
    (setq sum 0 
          i 0 
    ) 
    (while (if (setq bs (entsel "\n点取房间多义线:")) 
               (if (setq pt (getpoint ">>>点取标注点:")) 
                   T 
                   nil 
               ) 
               nil 
           ) 
        (command "_area" "o" bs) 
        (setq aa (getvar "area")) 
        (setq aa (/ aa 1000000.0)) 
        (setq str-aa (strcat "A=" (rtos aa 2 2) "㎡")) 
 
        (setq per (getvar "perimeter")) 
        (setq per (/ per 1000.0)) 
        　　　 
        (setq str-per (strcat "P=" (rtos per 2 2) "m")) 
 
        (setq txth (* (getvar "hpscale") 2.5)) 
        (setq ptu (polar pt (* 0.5 pi) (* txth 0.6)) 
              ptd (polar pt (* 1.5 pi) (* txth 0.6)) 
        ) 
        ;;设置捕捉 
        (setq os_old (getvar "osmode")) 
        (setvar "osmode" 0) 
        ;;写文字 
        (command "text" "j" "mc" ptu txth "0" str-aa) 
        (command "text" "j" "mc" ptd txth "0" str-per) 
        (command "erase" bs "") 
        ;;恢复捕捉设置 
        (setvar "osmode" os_old) 
        ;;面积累计 
        (setq sum (+ aa sum) 
              i          (1+ i) 
        ) 
        (princ (strcat ">>>第 " 
                       (itoa i) 
                       " 次，面积累计：" 
                       (rtos sum 2 2) 
                       "㎡" 
               ) 
        ) 
    ) 
 
    (setvar "cmdecho" 1) 
    (princ) 
)

yitian519 · 发表于 2007-4-5 12:15:49

(setq txth (* (getvar "hpscale") 2.5))

中的*是干什么用的？

zml84 · 发表于 2007-4-6 11:53:44

[PHP]
*是乘函数呀
[/PHP]

ahill · 发表于 2007-4-15 15:40:16

上面这个面积累加实际使用中用处不是特别大，作为一种辅助显示是不错的。上面这段小程序在实际使用中还发现了一个新问题就是字体的问题，具体的情况就在于上面这个 "㎡"　的显示，如果想要正确显示，那么这个 "㎡"　就要在字体文件为宋体的情况下才能正确显示出来，由于它是使用的默认当前字体样式，所以在个别使用的时候会导致一点儿小麻烦，可能会再用格式刷去刷一下。由于各人的DWT文件设置不一样，所以这个问题还不能使用一种通用方案解决，只有把它搞成一个运行前的必要设置过程了。再次谢谢　ZML84　和　HSSLYL　的关心和帮助！

附上这个小小 Lisp 最终文件内容：

;本程序适用于建筑类图纸经常需要标注房间的室内面积和周长时所用。
;在使用本程序前请先使用CAD的绘图命令生成各房间的封闭的多义线。
;在使用本程序前请先确认CAD的当前文字样式的字体文件为国标中文字体，并且默认字高设置为0。
;本程序默认原绘图单位为MM。
;欢迎传播和引用，请注明出处。

(DEFUN C:dda (/ sum bs aa per ptu ptd txth str-aa str-per)
(setvar "cmdecho" 0)
(princ
"\n说明:在使用本程序前请先生成房间的多义线!本程序默认原绘图单位为MM!"
)
(setq sum 0
   i 0
)
(while (if (setq bs (entsel "\n点取房间多义线:"))
         (if (setq pt (getpoint " >>>点取标注点:"))
   T
   nil
         )
         nil
   )
(command "_area" "o" bs)

(setq aa (/ (getvar "area") 1000000.0))
(setq str-aa (strcat "A=" (rtos aa 2 2) "㎡"))

(setq per (/ (getvar "perimeter") 1000.0))
(setq str-per (strcat "P=" (rtos per 2 2) "m"))

(setq txth (* (getvar "hpscale") 2.5))
(setq ptu (polar pt (* 0.5 pi) (* txth 0.7))
      ptd (polar pt (* 1.5 pi) (* txth 0.7))
)

(setq os_old (getvar "osmode"))
(setvar "osmode" 0)

(command "text" "j" "mc" ptu txth "0" str-aa)
(command "text" "j" "mc" ptd txth "0" str-per)
(command "erase" bs "")

(setvar "osmode" os_old)

(setq sum (+ aa sum)
      i    (1+ i)
)
(princ (strcat ">>>已标注 "
         (itoa i)
         " 个房间,面积累加为:"
         (rtos sum 2 2)
         "㎡"
         )
)
)

(setvar "cmdecho" 1)
(princ)
)
(princ "\n房间面积及周长自动标注程序，程序快捷键为 DDA !!! Design by Ahill & ZML84!!!")

daobuledeniu · 发表于 2014-7-9 21:40:03

很好的程序！谢谢分享！！！

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

[求助] [求助]：编了一个Lisp程序，出了两个小问题，请高手指教一下！

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

相关帖子