(GetTwoPt)带关键字拾取两点
本帖最后由 fangmin723 于 2025-4-25 09:52 编辑如果是拾取距离的话，使用getdist就可以了，
我这边不只需要距离，
后面还需要用到拾取的点，所以就用到了这个函数
;;说明:带关键字拾取两点
;;参数:keywords:关键字和描述信息的点表；'(("E" . "拾取曲线") ("P" . "拾取距离"))
;;返回:成功拾取两点：返回两点列表；触发关键字：返回关键字；否则：返回nil
(defun GetTwoPt(keywords / join-symbol keywordstr model promptstr pt1 pt2)
(defun join-symbol(lst symbol)
(if (and lst (apply 'and (mapcar '(lambda(x) (equal (type x) 'STR)) lst)))
(apply 'strcat (cons (strcase (car lst)) (mapcar '(lambda (x) (strcat symbol (strcase x) )) (cdr lst))))
nil
)
)
(setq
keywordstr (join-symbol (mapcar 'car keywords) " ")
promptstr (join-symbol (mapc
ar '(lambda(x) (strcat (cdr x) "(" (car x) ")")) keywords) "/")
)
(initget keywordstr)
(if (setq pt1 (getpoint (strcat "\n拾取第一点[" promptstr "]")))
(if (equal (type pt1) 'STR)
(setq model (strcase pt1))
(progn
(initget keywordstr)
(if (setq pt2 (getpoint pt1 (strcat "\n拾取第二点[" promptstr "]")))
(if (equal (type pt2) 'STR)
(setq model (strcase pt2))
(list pt1 pt2)
)
nil
)
)
)
nil
)
)
GetTwoPt函数的简单应用
(if (setq model "P" pts (GetTwoPt '(("E" . "拾取曲线"))))
(progn
(while (equal (type pts) 'STR)
(setq pts (strcase pts) model pts)
(cond
((equal pts "P")
(setq pts (GetTwoPt '(("E" . "拾取曲线"))))
)
((equal pts "E")
(initget "P")
(setq pts (entsel "\n拾取直线,多段线,圆(弧),椭圆(弧)[拾取距离(P)]:"))
)
)
)
(if pts
(cond
((equal model "P")
.
.
.
)
((equal model "E")
.
.
.
)
)
)
)
)
感谢大佬共享代码 ！简单应用中的cond函数括弧是不是有点问题？ guosheyang 发表于 2025-4-25 08:33
感谢大佬共享代码 ！简单应用中的cond函数括弧是不是有点问题？
有啥问题？？？ fangmin723 发表于 2025-4-25 08:46
有啥问题？？？
最后一个cond
(if pts
(cond
((equal model "P")
(princ "1")
)
)
((equal model "E")
(princ "2")
)
) 本帖最后由 fangmin723 于 2025-4-25 09:55 编辑
guosheyang 发表于 2025-4-25 09:15
最后一个cond
(if pts
(cond
好的，谢谢，可能是在删除里面代码时没注意，已经改好了
页:
[1]