[求助]请问如何编程实现任意的多边形的绘制
<p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt;">要求：</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt; TEXT-INDENT: 21pt; mso-char-indent-count: 2.0;">如同<font face="Times New Roman">CAD</font>中选择实体的“<font face="Times New Roman">WP</font>”功能，在绘制任意多边形时，鼠标在屏幕上拾取点的时候，总是同时和上一点以及第一点相连，在任何时候看都是一个多边形。</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt; TEXT-INDENT: 21pt; mso-char-indent-count: 2.0;"></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt; TEXT-INDENT: 21pt; mso-char-indent-count: 2.0;">一般的做法就只能让鼠标和上一点有连线(如getpoint函数)，到最后选择“<font face="Times New Roman">c</font>”让多义线（<font face="Times New Roman">lwpline</font>）闭合构成多边形。这里我希望在绘制过程中，屏幕上可看到鼠标不但和上一点有连线，同时还和第一点有连线。</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt; TEXT-INDENT: 21pt; mso-char-indent-count: 2.0;"></p> 这个我已经想很久了，请各位大侠支招，不胜感激！ <p>直接用ssget的wp</p><p>提取点位生成多义线</p> <p>我的目的是用这种方法画多边形。</p><p>而如果直接用ssget的wp，那么就选中了里面的图元。况且如何获得wp的点哪？我认为用wp的功能，点位是应该事先知道的。请问能用了wp之后来提取点表？那么用什么函数？这种思路可行么？</p> 本帖最后由 作者 于 2007-8-30 2:51:44 编辑发两个，推荐用第二个
(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
);; 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 ppt 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
)
楼主要的应该是这个东东：
;;;==============================================================================
(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)
)
动画演示见：http://www.acad.net.cn/viewthread.php?tid=432&extra=page%3D1
不错，有想法：） <p>演示效果附上：</p><p></p> <p>首先很感谢无痕 和 ZML84 两位大侠的帮助，程序各有特色，真的非常感谢！</p><p> 小弟在运行大侠ZML84的程序TT的时候，鼠标点击两个点后，出现以下两个问题：</p><p>1.点取后面点的时候， 十字光标就开始闪烁的厉害。下面命令栏显示：指定下一点或 [圆弧(A)/闭合(C)/半宽(H)/长度(L)/放弃(U)/宽度(W)]: non。 并不是大侠演示的时候显示的仅仅有：指定下一点。</p><p> 2. 在最后结束的时候，按右键和回车程序都没有反应，按两次ESC才能结束程序，但是多边形最后没有闭合，就是最后一点没有和第一点连接。</p><p> 在此要说的是我拷贝大侠ZML84的5楼代码后，把每行前面单个的“；”去掉了。</p><p> 我的现象和大侠ZML84的演示有很大出入，请大侠赐教！</p> <p>还是帖出我运行的代码，希望高人指点！</p><p>(defun C:TT ()<br/> (if (and (setq PT1 (getpoint "\n起始点: "))<br/> (setq PT2 (getpoint PT1 "\n指定下一点: "))<br/> )<br/> (progn<br/> (command "_.pline" "non" PT1 "non" PT2)<br/> (setq TEST t)<br/> (while TEST<br/> (setq TMP (grread t 7 0))<br/> (redraw);重新绘制当前视口<br/> (cond ((= (car TMP) 3) ;_左键<br/> (setq PT2 (cadr TMP))<br/> (command "non" PT2)<br/> )<br/> ((= (car TMP) 11) ;_右键<br/> (command "c") <br/> (setq TEST NIL)<br/> )<br/> ((= (car TMP) 5) ;_移动<br/> (setq PT (cadr TMP))<br/> (grdraw PT PT1 1 1)<br/> (grdraw PT PT2 2)<br/> )<br/> )<br/> ) ;_结束 while<br/> )<br/> )<br/> (princ)<br/>)</p> <p>1.点取后面点的时候， 十字光标就开始闪烁的厉害。<br/>2.下面命令栏显示：指定下一点或 [圆弧(A)/闭合(C)/半宽(H)/长度(L)/放弃(U)/宽度(W)]: non。 并不是大侠演示的时候显示的仅仅有：指定下一点。<br/>3. 在最后结束的时候，按右键和回车程序都没有反应，按两次ESC才能结束程序，但是多边形最后没有闭合，就是最后一点没有和第一点连接。</p><br/>1、因为使用了 redraw 函数来重绘视口，当图中对象多时，会出现闪烁。<br/>2、在程序中关闭命令行回显便可。（setvar "cmdecho" 0）<br/>3、右键没有反应，是因为在你那里，grread函数的返回值第一项不是 11。<br/>grread函数的返回值因版本和机器不同而不同，其原因不明。<br/>
页:
[1]
2