(GetTwoPt)带关键字拾取两点

fangmin723

如果是拾取距离的话，使用getdist就可以了，

我这边不只需要距离，

后面还需要用到拾取的点，所以就用到了这个函数

1. ;;说明:带关键字拾取两点
   
2. ;;参数:keywords:关键字和描述信息的点表；'(("E" . "拾取曲线") ("P" . "拾取距离"))
   
3. ;;返回:成功拾取两点：返回两点列表；触发关键字：返回关键字；否则：返回nil
   
4. (defun GetTwoPt(keywords / join-symbol keywordstr model promptstr pt1 pt2)
   
5.   (defun join-symbol(lst symbol)
   
6.     (if (and lst (apply 'and (mapcar '(lambda(x) (equal (type x) 'STR)) lst)))
   
7.       (apply 'strcat (cons (strcase (car lst)) (mapcar '(lambda (x) (strcat symbol (strcase x) )) (cdr lst))))
   
8.       nil
   
9.     )
   
10.   )
    
11.   (setq
    
12.     keywordstr (join-symbol (mapcar 'car keywords) " ")
    
13.     promptstr (join-symbol (mapc
    
14. ar '(lambda(x) (strcat (cdr x) "(" (car x) ")")) keywords) "/")
    
15.   )
    
16.   (initget keywordstr)
    
17.   (if (setq pt1 (getpoint (strcat "\n拾取第一点[" promptstr "]")))
    
18.     (if (equal (type pt1) 'STR)
    
19.       (setq model (strcase pt1))
    
20.       (progn
    
21.         (initget keywordstr)
    
22.         (if (setq pt2 (getpoint pt1 (strcat "\n拾取第二点[" promptstr "]")))
    
23.           (if (equal (type pt2) 'STR)
    
24.             (setq model (strcase pt2))
    
25.             (list pt1 pt2)
    
26.           )
    
27.           nil
    
28.         )
    
29.       )
    
30.     )
    
31.     nil
    
32.   )
    
33. )

;;说明:带关键字拾取两点<br /> ;;参数:keywords:关键字和描述信息的点表；'(("E" . "拾取曲线") ("P" . "拾取距离"))<br /> ;;返回:成功拾取两点：返回两点列表；触发关键字：返回关键字；否则：返回nil<br /> (defun GetTwoPt(keywords / join-symbol keywordstr model promptstr pt1 pt2)<br />   (defun join-symbol(lst symbol)<br />     (if (and lst (apply 'and (mapcar '(lambda(x) (equal (type x) 'STR)) lst)))<br />       (apply 'strcat (cons (strcase (car lst)) (mapcar '(lambda (x) (strcat symbol (strcase x) )) (cdr lst))))<br />       nil<br />     )<br />   )<br />   (setq<br />     keywordstr (join-symbol (mapcar 'car keywords) " ")<br />     promptstr (join-symbol (mapc<br /> ar '(lambda(x) (strcat (cdr x) "(" (car x) ")")) keywords) "/")<br />   )<br />   (initget keywordstr)<br />   (if (setq pt1 (getpoint (strcat "\n拾取第一点[" promptstr "]")))<br />     (if (equal (type pt1) 'STR)<br />       (setq model (strcase pt1))<br />       (progn<br />         (initget keywordstr)<br />         (if (setq pt2 (getpoint pt1 (strcat "\n拾取第二点[" promptstr "]")))<br />           (if (equal (type pt2) 'STR)<br />             (setq model (strcase pt2))<br />             (list pt1 pt2)<br />           )<br />           nil<br />         )<br />       )<br />     )<br />     nil<br />   )<br /> )

GetTwoPt函数的简单应用

1. (if (setq model "P" pts (GetTwoPt '(("E" . "拾取曲线"))))
   
2.   (progn
   
3.     (while (equal (type pts) 'STR)
   
4.       (setq pts (strcase pts) model pts)
   
5.       (cond
   
6.         ((equal pts "P")
   
7.           (setq pts (GetTwoPt '(("E" . "拾取曲线"))))
   
8.         )
   
9.         ((equal pts "E")
   
10.           (initget "P")
    
11.           (setq pts (entsel "\n拾取直线,多段线,圆(弧),椭圆(弧)[拾取距离(P)]:"))
    
12.         )
    
13.       )
    
14.     )
    
15.     (if pts
    
16.       (cond
    
17.         ((equal model "P")
    
18.           .
    
19.           .
    
20.           .
    
21.         )
    
22.         ((equal model "E")
    
23.           .
    
24.           .
    
25.           .
    
26.         )
    
27.       )
    
28.     )
    
29.   )
    
30. )

(if (setq model "P" pts (GetTwoPt '(("E" . "拾取曲线"))))<br />   (progn<br />     (while (equal (type pts) 'STR)<br />       (setq pts (strcase pts) model pts)<br />       (cond<br />         ((equal pts "P")<br />           (setq pts (GetTwoPt '(("E" . "拾取曲线"))))<br />         )<br />         ((equal pts "E")<br />           (initget "P")<br />           (setq pts (entsel "\n拾取直线,多段线,圆(弧),椭圆(弧)[拾取距离(P)]:"))<br />         )<br />       )<br />     )<br />     (if pts<br />       (cond<br />         ((equal model "P")<br />           .<br />           .<br />           .<br />         )<br />         ((equal model "E")<br />           .<br />           .<br />           .<br />         )<br />       )<br />     )<br />   )<br /> )

guosheyang

感谢大佬共享代码 ！  简单应用中的cond函数  括弧是不是有点问题？

fangmin723

guosheyang 发表于 2025-4-25 08:33
感谢大佬共享代码 ！  简单应用中的cond函数  括弧是不是有点问题？

有啥问题？？？

guosheyang

fangmin723 发表于 2025-4-25 08:46
有啥问题？？？

最后一个cond   
(if pts
      (cond
        ((equal model "P")
          (princ "1")
        )
      )
      ((equal model "E")
        (princ "2")
      )
    )

fangmin723

guosheyang 发表于 2025-4-25 09:15
最后一个cond   
(if pts
      (cond

好的，谢谢，可能是在删除里面代码时没注意，已经改好了