动态标注程序，坐标系变换，程序就会卡死

陈同学 · 发表于 2021-8-26 15:46:32

动态标注程序，坐标系变换，程序就会卡死，但是单独创建一个文件就可以。每次一到输入基点，程序就暂停了，按ESC退出还会显示应用程序错误: 控制台中断，希望大神帮忙解决一下小问题，感激！！！！
程序如下：

;动态标注*********************************************
(defun ybz (/ *error* name1 name2 name3)
(setq ty (getvar "TEXTSTYLE"))
(setq kd1 (caadr (textbox (list '(0 . "text")
(cons 1 txt1)
(cons 40 300)
(cons 41 0.75)
(cons 7 ty)
)
)
)
)
;字高300，字宽高比0.75，可以自己设置，字体为当前字体
(setq kd2 (caadr (textbox (list '(0 . "text")
(cons 1 txt2)
(cons 40 300)
(cons 41 0.75)
(cons 7 ty)
)
)
)
)
;字高300，字宽高比0.75，可以自己设置，字体为当前字体
(setq kd (max kd1 kd2)
kd (+ kd 50)
)
(setq p (getpoint "\n输入基点:"))
;(setq p (pucs_wucs p))
(setq pd t)
(while pd
(setq gr (grread t 4 1)
mode (car gr)
pt (cadr gr)
)
(if (= kd3 0)
(setq kd kd1)
)
;(setq pt (pucs_wucs pt))
(if (and (listp pt) (>= (car pt) (car p)))
(progn
(setq p0 (polar pt 0 kd))
(setq p1 (polar pt 0 (/ (- kd kd1) 2))
p1 (polar p1 (angtof "90") 50)
)
(setq p2 (polar pt 0 (/ (- kd kd2) 2))
p2 (polar p2 (angtof "270") 450)
)
)
)
(if (and (listp pt) (< (car pt) (car p)))
(progn
(setq p0 (polar pt pi kd))
(setq p1 (polar p0 0 (/ (- kd kd1) 2))
p1 (polar p1 (angtof "90") 50)
)
(setq p2 (polar p0 0 (/ (- kd kd2) 2))
p2 (polar p2 (angtof "270") 450)
)
)
)
(if (= mode 5)
(progn
(if name1
(entdel name1)
)
(entmake (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(6 . "Continuous")
'(90 . 3)
(cons 10 (pucs_wucs p))
(cons 10 (pucs_wucs pt))
(cons 10 (pucs_wucs p0))
)
)
(setq name1 (entlast))
(if name2
(entdel name2)
)
(setq ag (if (> (get_angle_pucs_wucs) 180)
(max (angle (pucs_wucs pt) (pucs_wucs p0))
(angle (pucs_wucs p0) (pucs_wucs pt))
)
(min (angle (pucs_wucs pt) (pucs_wucs p0))
(angle (pucs_wucs p0) (pucs_wucs pt))
)
)
)
(entmake (list '(0 . "text")
(cons 1 txt1)
(cons 40 350)
(cons 41 0.75)
(cons 10 (pucs_wucs p1))
(cons 50 ag)
(cons 7 ty)
)
)
;字高300，字宽高比0.75，可以自己设置，字体为当前字体
(setq name2 (entlast))
(if name3
(entdel name3)
)
(if (= kd3 1)
(entmake (list '(0 . "text")
(cons 1 txt2)
(cons 40 350)
(cons 41 0.75)
(cons 50 ag)
(cons 10 (pucs_wucs p2))
(cons 7 ty)
)
)
)
;字高300，字宽高比0.75，可以自己设置，字体为当前字体
(if (= kd3 1)
(setq name3 (entlast))
)
)
)
(if (= mode 3)
(setq pd nil)
)
(if (or (= mode 2) (= mode 25))
(progn (setq pd nil)
(entdel name1)
(entdel name2)
(if name3
(entdel name3)
)
)
)
)
(princ)
)
(defun c:bb ()
;(步骤1)建立临时对话框
(setq tempname (vl-filename-mktemp "temp.dcl") filen (open tempname "w"))
(foreach stream
'("yxbz:dialog{"
"\n label = "动态引线标注";"
"\n :edit_box {key = \"a1\"; label = \"线上文字:\"; width = 40 ;}"
"\n :toggle {key = \"a3\"; label = \"增加线下文字\"; value = "0";}"
"\n :edit_box {key = \"a2\"; label = \"线下文字:\"; width = 40; is_enabled = false;}"
"\n ok_cancel;}")
(princ stream filen))
(close filen)
(setq dclname tempname)
;(步骤2)加载并显示对话框
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yxbz" dcl_re)) (exit))
;(步骤3)定义对话框控件（运用set_tile、action_tile、mode_tile、get_tile等函数）
(if txt1 (set_tile "a1" txt1) (set_tile "a1" "动态标注"))
(if txt2 (set_tile "a2" txt2) (set_tile "a2" "动态标注"))
(if kd3 (set_tile "a3" (rtos kd3))) ;注意set_tile函数中赋值均为字符串（带双引号），就连关键词也要加上双引号。
(if (= kd3 0) (mode_tile "a2" 1))
(if (= kd3 1) (mode_tile "a2" 0))
(action_tile "a3" "(if (= (get_tile \"a3\") \"0\") (mode_tile \"a2\" 1) (mode_tile \"a2\" 0))") ;点击时才起作用
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog)")
;(步骤4)激活并卸载对话框，并进行对话框隐藏后的操作。
(setq std (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= std 1) (ybz))
(princ))

foolishzy · 发表于 2023-6-5 11:33:55

chenhonghan？

陈同学 · 发表于 2024-7-29 20:28:26

foolishzy 发表于 2023-6-5 11:33
chenhonghan？

who are you？

lee50310 · 发表于 2024-7-30 09:11:48

本帖最后由 lee50310 于 2024-7-30 16:44 编辑

error: no function definition: getdata
程式執行後缺少(1) getdata 函數  ,
                  (2) pucs_wucs 函數,
                  (3) get_angle_pucs_wucs 函數請補上

foolishzy · 发表于 2024-8-2 08:52:46

陈同学发表于 2024-7-29 20:28
who are you？

仔细想想你的代码哪里来的

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

[源码] 动态标注程序，坐标系变换，程序就会卡死