[求助]请问如何编程实现任意的多边形的绘制

water_fire

要求：

如同CAD中选择实体的“WP”功能，在绘制任意多边形时，鼠标在屏幕上拾取点的时候，总是同时和上一点以及第一点相连，在任何时候看都是一个多边形。

一般的做法就只能让鼠标和上一点有连线(如getpoint函数)，到最后选择“c”让多义线（lwpline）闭合构成多边形。这里我希望在绘制过程中，屏幕上可看到鼠标不但和上一点有连线，同时还和第一点有连线。

  这个我已经想很久了，请各位大侠支招，不胜感激！

无痕

直接用ssget的wp

提取点位生成多义线

water_fire

我的目的是用这种方法画多边形。

而如果直接用ssget的wp，那么就选中了里面的图元。况且如何获得wp的点哪？我认为用wp的功能，点位是应该事先知道的。请问能用了wp之后来提取点表？那么用什么函数？这种思路可行么？

无痕

发两个，推荐用第二个

2. (defun c:sspl (/ ss pts plobj);; 必须要框中物体才能画出多义线.
3.   (command ".select" "SI" "Cp")
4.   (while (/= 0 (getvar "cmdactive")) (command pause))
5.   (command)
6.   (setq lp (getvar "lastpoint"))
7.   (setq pts (mapcar 'cadr (cdr (assoc -1 (ssnamex (ssget "p")))))
8. pts (mapcar '(lambda (x) (list (car x) (cadr x))) pts)
9.   )
10.   (setq plobj (vlax-invoke (vla-get-modelspace
11.         (vla-get-activedocument (vlax-get-acad-object))
12.       )
13.       'AddLightweightPolyline
14.       (apply 'append pts)
15.        )
16.   )
17.   (vla-put-closed plobj :vlax-true)
18.   plobj
19. )

(defun c:sspl (/ ss pts plobj);; 必须要框中物体才能画出多义线.   (command ".select" "SI" "Cp")   (while (/= 0 (getvar "cmdactive")) (command pause))   (command)   (setq lp (getvar "lastpoint"))   (setq pts (mapcar 'cadr (cdr (assoc -1 (ssnamex (ssget "p"))))) pts (mapcar '(lambda (x) (list (car x) (cadr x))) pts)   )   (setq plobj (vlax-invoke (vla-get-modelspace         (vla-get-activedocument (vlax-get-acad-object))       )       'AddLightweightPolyline       (apply 'append pts)        )   )   (vla-put-closed plobj :vlax-true)   plobj )

2. ;; sspl = 点选连线生成多义线.
3. (defun c:sspl2 (/ pts plobj)
4.   (if (setq ss (ssadd)
5.      pt (getpoint "\n 选取第一点:")
6.      pts (list (list(car pt)(cadr pt))))
7.     (while (setq p (getpoint pt "\n 选下一点:"))
8.       (grdraw p  pt 2 1)
9.       (setq pt p
10.               pts (cons (list (car pt)(cadr pt)) pts)
11.   )))
12.   (mapcar '(lambda(x y)(grdraw x y 0)) pts (cdr pts))
13.   (setq pts (reverse pts))
14.   (if (and pts (< 1 (length pts)))
15.     (progn (setq plobj (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
16.         'AddLightweightPolyline
17.         (apply 'append pts)))
18.         (vla-put-closed plobj :vlax-true)
19.     )
20.   )
21.   plobj
22. )

;; sspl = 点选连线生成多义线. (defun c:sspl2 (/ pts plobj)   (if (setq ss (ssadd)      pt (getpoint "\n 选取第一点:")      pts (list (list(car pt)(cadr pt))))     (while (setq p (getpoint pt "\n 选下一点:"))       (grdraw p  pt 2 1)       (setq pt p               pts (cons (list (car pt)(cadr pt)) pts)   )))   (mapcar '(lambda(x y)(grdraw x y 0)) pts (cdr pts))   (setq pts (reverse pts))   (if (and pts (< 1 (length pts)))     (progn (setq plobj (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))         'AddLightweightPolyline         (apply 'append pts)))         (vla-put-closed plobj :vlax-true)     )   )   plobj )

zml84

楼主要的应该是这个东东：

3. ;;;==============================================================================
4. (defun C:TT ()
5. &#160;&#160;&#160; (if&#160;&#160; &#160;(and (setq PT1 (getpoint "\n起始点: "))
6. &#160;&#160; &#160;&#160;&#160;&#160;&#160; (setq PT2 (getpoint PT1 "\n指定下一点: "))
7. &#160;&#160; &#160;)
8. &#160;&#160; &#160;(progn
9. &#160;&#160; &#160;&#160;&#160;&#160; (command "_.pline" "non" PT1 "non" PT2)
10. &#160;&#160; &#160;&#160;&#160;&#160; (setq TEST t)
11. &#160;&#160; &#160;&#160;&#160;&#160; (while TEST
12. &#160;&#160; &#160;&#160;&#160; &#160;(setq TMP (grread t 7 0))
13. &#160;&#160; &#160;&#160;&#160; &#160;(redraw)
14. &#160;&#160; &#160;&#160;&#160; &#160;(cond ((= (car TMP) 3) ;_左键
15. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq PT2 (cadr TMP))
16. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (command "non" PT2)
17. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; )
18. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ((= (car TMP) 11) ;_右键
19. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (command "c")
20. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq TEST NIL)
21. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; )
22. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ((= (car TMP) 5) ;_移动
23. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq PT (cadr TMP))
24. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (grdraw PT PT1 1 1)
25. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (grdraw PT PT2 2)
26. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; )
27. &#160;&#160; &#160;&#160;&#160; &#160;)
28. &#160;&#160; &#160;&#160;&#160;&#160; ) ;_结束 while
29. &#160;&#160; &#160;)
30. &#160;&#160;&#160; )
31. &#160;&#160;&#160; (princ)
32. )

;;;============================================================================== (defun C:TT () &#160;&#160;&#160; (if&#160;&#160; &#160;(and (setq PT1 (getpoint "\n起始点: ")) &#160;&#160; &#160;&#160;&#160;&#160;&#160; (setq PT2 (getpoint PT1 "\n指定下一点: ")) &#160;&#160; &#160;) &#160;&#160; &#160;(progn &#160;&#160; &#160;&#160;&#160;&#160; (command "_.pline" "non" PT1 "non" PT2) &#160;&#160; &#160;&#160;&#160;&#160; (setq TEST t) &#160;&#160; &#160;&#160;&#160;&#160; (while TEST &#160;&#160; &#160;&#160;&#160; &#160;(setq TMP (grread t 7 0)) &#160;&#160; &#160;&#160;&#160; &#160;(redraw) &#160;&#160; &#160;&#160;&#160; &#160;(cond ((= (car TMP) 3) ;_左键 &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq PT2 (cadr TMP)) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (command "non" PT2) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ((= (car TMP) 11) ;_右键 &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (command "c") &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq TEST NIL) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ((= (car TMP) 5) ;_移动 &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (setq PT (cadr TMP)) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (grdraw PT PT1 1 1) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (grdraw PT PT2 2) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; &#160;) &#160;&#160; &#160;&#160;&#160;&#160; ) ;_结束 while &#160;&#160; &#160;) &#160;&#160;&#160; ) &#160;&#160;&#160; (princ) )

动画演示见：http://www.acad.net.cn/viewthread.php?tid=432&extra=page%3D1

无痕

不错，有想法：）

zml84

演示效果附上：

water_fire

首先很感谢无痕 和 ZML84 两位大侠的帮助，程序各有特色，真的非常感谢！

  小弟在运行大侠ZML84的程序TT的时候，鼠标点击两个点后，出现以下两个问题：

1.点取后面点的时候， 十字光标就开始闪烁的厉害。下面命令栏显示：指定下一点或 [圆弧(A)/闭合(C)/半宽(H)/长度(L)/放弃(U)/宽度(W)]: non。  并不是大侠演示的时候显示的仅仅有：指定下一点。

 2. 在最后结束的时候，按右键和回车程序都没有反应，按两次ESC才能结束程序，但是多边形最后没有闭合，就是最后一点没有和第一点连接。

     在此要说的是我拷贝大侠ZML84的5楼代码后，把每行前面单个的“；”去掉了。

  我的现象和大侠ZML84的演示有很大出入，请大侠赐教！

water_fire

还是帖出我运行的代码，希望高人指点！

(defun C:TT ()
    (if (and (setq PT1 (getpoint "\n起始点: "))
             (setq PT2 (getpoint PT1 "\n指定下一点: "))
        )
        (progn
            (command "_.pline" "non" PT1 "non" PT2)
            (setq TEST t)
            (while TEST
                (setq TMP (grread t 7 0))
                (redraw);重新绘制当前视口
                (cond ((= (car TMP) 3) ;_左键
                       (setq PT2 (cadr TMP))
                       (command "non" PT2)
                      )
                      ((= (car TMP) 11) ;_右键
                       (command "c")                      
                       (setq TEST NIL)
                      )
                      ((= (car TMP) 5) ;_移动
                       (setq PT (cadr TMP))
                       (grdraw PT PT1 1 1)
                       (grdraw PT PT2 2)
                      )
                )
            ) ;_结束 while
        )
    )
    (princ)
)

zml84

1.点取后面点的时候， 十字光标就开始闪烁的厉害。
2.下面命令栏显示：指定下一点或 [圆弧(A)/闭合(C)/半宽(H)/长度(L)/放弃(U)/宽度(W)]: non。  并不是大侠演示的时候显示的仅仅有：指定下一点。
3. 在最后结束的时候，按右键和回车程序都没有反应，按两次ESC才能结束程序，但是多边形最后没有闭合，就是最后一点没有和第一点连接。

1、因为使用了 redraw 函数来重绘视口，当图中对象多时，会出现闪烁。
2、在程序中关闭命令行回显便可。（setvar "cmdecho" 0）
3、右键没有反应，是因为在你那里，grread函数的返回值第一项不是 11。
grread函数的返回值因版本和机器不同而不同，其原因不明。