kerrywm 发表于 2006-11-29 23:22:00

[LISP]一个实用的LISP程序

<P>以下程序用来判断多义线的时针方向</P>
<P>(DEFUN GE_WHATPOLY (OBJ / NVERTS CNT TMP X1 Y1);;;<BR>&nbsp; (SETQ PT_LIST(VLA-GET-COORDINATES OBJ))<BR>&nbsp; (SETQ CNT 0)<BR>&nbsp; (SETQ NVERTS(/ (+(VLAX-SAFEARRAY-GET-U-BOUND (VLAX-VARIANT-VALUE PT_LIST ) 1)1) 2))<BR>&nbsp; (SETQ AREA 0.0)<BR>&nbsp; (WHILE (&lt; CNT (1- NVERTS))<BR>&nbsp;&nbsp;&nbsp; (SETQ Y1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) (+(* CNT 2)1)))<BR>&nbsp;&nbsp;&nbsp; (SETQ X1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) (* (+ CNT 1) 2)))<BR>&nbsp;&nbsp;&nbsp; (SETQ AREA(+ AREA (* Y1 X1)))<BR>&nbsp;&nbsp;&nbsp; (SETQ CNT(1+ CNT))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; (SETQ Y1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) (+(* CNT 2)1)))<BR>&nbsp; (SETQ X1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) 0))<BR>&nbsp; (SETQ AREA(+ AREA(* Y1 X1)))<BR>&nbsp; (SETQ CNT 0)<BR>&nbsp; (SETQ TMP 0.0)<BR>&nbsp; (WHILE (&lt; CNT (1- NVERTS))<BR>&nbsp;&nbsp;&nbsp; (SETQ Y1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) (+(* (+ CNT 1) 2)1)))<BR>&nbsp;&nbsp;&nbsp; (SETQ X1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST ) (* CNT 2)))<BR>&nbsp;&nbsp;&nbsp; (SETQ TMP(+ TMP (* Y1 X1)))<BR>&nbsp;&nbsp;&nbsp; (SETQ CNT(+ CNT 1))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; (SETQ Y1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST )1))<BR>&nbsp; (SETQ X1(VLAX-SAFEARRAY-GET-ELEMENT (VLAX-VARIANT-VALUE PT_LIST)(* CNT 2)))<BR>&nbsp; (SETQ TMP(+ TMP (* Y1 X1)))<BR>&nbsp; (SETQ AREA(- AREA TMP))<BR>&nbsp; (COND<BR>&nbsp;&nbsp;&nbsp; ((&lt; AREA 0.0) (SETQ AREA -1))<BR>&nbsp;&nbsp;&nbsp; ((&gt; AREA 0.0) (SETQ AREA 1))<BR>&nbsp;&nbsp;&nbsp; (T (SETQ AREA 0))<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; AREA<BR>&nbsp; )</P>
<P>对不住大家，程序没有注解，如果返回值为正，则曲线为顺时针方向。</P>

mccad 发表于 2006-11-30 08:24:00

<P>多谢共享，为大家提供一种新的方法。</P>
<P>另外一种方法是偏移法，利用AX中的偏移法，几行代码就可完成。可查看源码共享版块。</P>

wxa123wl 发表于 2019-4-12 02:57:41

mccad 发表于 2006-11-30 08:24
多谢共享，为大家提供一种新的方法。
另外一种方法是偏移法，利用AX中的偏移法，几行代码就可完成。可查看 ...

哪里呢，给个链接
页: [1]
查看完整版本: [LISP]一个实用的LISP程序