明总，是否允许拿别人的程序卖钱？？？
各版主,我发现有的人拿别人的程序卖钱，本人认为这是不道德的。不知版主们对此观点如何？？？
附别人的：（激光镜面反射LISP）
;| ;;
DLaser (dynamic Laser) v.1.0 Copyright ?2010 ;;
Idea conception by: Andrea Andreetti Sept. 2010 ;;
Programmation by: Lee McDonnell and Andrea Andreetti;;
|;
(defun c:DLaser ( / *error* A BASE CODE DATA GR GRLST MUTT P P1 PTS SS TMP)
(vl-load-com)
(defun *error* ( msg )
(setvar 'NOMUTT mutt)
(and tmp (not (vlax-erased-p tmp)) (vla-delete tmp))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw) (princ)
)
(LM:ActiveSpace 'doc 'spc)
(setq mutt (getvar 'NOMUTT))
(if
(and
(progn (initget 6)
(setq ref*
(cond
(
(getint
(strcat "\nSpecify Number of Reflections <"
(itoa
(setq ref* (cond ( ref* ) ( 1 )))
)
"> : "
)
)
)
( ref* )
)
)
)
(progn
(setvar 'NOMUTT 1)
(princ "\nSelect Objects to Interfere...")
(setq ss(LM:ss->vla (ssget '((0 . "ARC,ELLIPSE,*LINE,CIRCLE")))))
)
(setvar 'NOMUTT 0)
(setq p1(getpoint "\nPick Laser Location: "))
(princ "\nDirect Laser...")
)
(while
(progn
(setq gr (grread t 15 0) code (car gr) data (cadr gr))
(cond
(
(= 5 code) (redraw)
(setq data (polar p1 (angle p1 (cadr gr)) (* 2. (getvar 'VIEWSIZE))))
(setq a (angle p1 data) base p1 grLst (list base))
(if
(
(lambda ( i )
(while (and (<= (setq i (1+ i)) ref*) (setq pts (GetDeflectionPoints ss base data)))
(setq grLst
(if (< 2 (length grLst))
(append (reverse pts) (cons (car pts) (cdr grLst)))
(append (reverse pts) (cons (car pts) grLst))
)
)
(setq base (car pts) data (cadr pts))
t
)
)
0
);;Mod by A.Andreetti
(progn
(grvecs (cons 1 (setq grLst (reverse grLst))))
(if (> (distance p1 (cadr gr)) (distance p1 (cadr grLst)))
(grdraw (cadr gr) (cadr grLst) 8 1)
)
)
(grdraw p1 (polar p1 a (* 2. (getvar 'VIEWSIZE))) 1)
);;Mod by A.Andreetti
t
)
(
(= 3 code)
(setq a (angle p1 data))
(if grLst
(not
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length (setq grLst (LM:Unique grLst))))
(cons 70 0)
)
(mapcar '(lambda ( p ) (cons 10 p)) grLst)
)
)
)
)
)
)
)
)
)
(setvar 'NOMUTT mutt)
(redraw)
(princ)
)
(defun GetDeflectionPoints ( objs p1 p2 / tmp lst a1 a2 r par )
(setq tmp (vlax-invoke spc 'AddLine p1 p2))
(if (setq lst
(vl-remove 'nil
(mapcar
(function
(lambda ( obj / p )
(if (and (setq p (vlax-invoke tmp 'IntersectWith obj acExtendNone))
(setq p (vl-remove-if '(lambda ( x ) (equal p1 x 1e-6)) (LM:GroupByNum p 3))))
(list obj
(car
(vl-sort p
(function
(lambda ( a b ) (< (distance p1 a) (distance p1 b)))
)
)
)
)
)
)
)
objs
)
)
)
(progn
(setq lst
(car
(vl-sort lst
(function
(lambda ( a b ) (< (distance p1 (cadr a)) (distance p1 (cadr b))))
)
)
)
)
(if (setq par (vlax-curve-getParamatPoint (setq e (vlax-vla-object->ename (car lst))) (cadr lst)))
(progn
(setq a1 (angle (cadr lst) p1)
a2 (rem
(+ (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e par)) (/ (* 3 pi) 2.))
(* 2 pi)
)
r (list (cadr lst) (polar (cadr lst) (+ a2 (- a2 a1)) (* (getvar 'VIEWSIZE) 2.0)))
)
(grdraw (cadr lst)
(polar (cadr lst) (if (< (/ pi 2.) (abs (- a1 a2))) (+ a2 pi) a2) (* (getvar 'VIEWSIZE) 0.25)) 153 1
)
)
)
)
)
(vla-delete tmp) (setq tmp nil)
r
)
;;--------------------=={ ActiveSpace }==---------------------;;
;; ;;
;;Retrieves pointers to the Active Document and Space ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright ?2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;*doc - quoted symbol other than *doc ;;
;;*spc - quoted symbol other than *spc ;;
;;------------------------------------------------------------;;
(defun LM:ActiveSpace ( *doc *spc )
;; ?Lee Mac 2010
(set *spc
(if
(or
(eq AcModelSpace
(vla-get-ActiveSpace
(set *doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(eq :vlax-true (vla-get-MSpace (eval *doc)))
)
(vla-get-ModelSpace (eval *doc))
(vla-get-PaperSpace (eval *doc))
)
)
)
;;-----------------=={ SelectionSet -> VLA }==----------------;;
;; ;;
;;Converts a SelectionSet to a list of VLA Objects ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright ?2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - Valid SelectionSet (Pickset) ;;
;;------------------------------------------------------------;;
;;Returns:List of VLA Objects ;;
;;------------------------------------------------------------;;
(defun LM:ss->vla ( ss )
;; ?Lee Mac 2010
(if ss
(
(lambda ( i / e l )
(while (setq e (ssname ss (setq i (1+ i))))
(setq l (cons (vlax-ename->vla-object e) l))
)
l
)
-1
)
)
)
;;-----------------=={ Group by Number }==--------------------;;
;; ;;
;;Groups a list into a list of lists, each of length 'n' ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright ?2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;l - List to process ;;
;;n - Number of elements by which to group ;;
;;------------------------------------------------------------;;
;;Returns:List of lists, each of length 'n' ;;
;;------------------------------------------------------------;;
(defun LM:GroupByNum ( l n / a b )
;; ?Lee Mac 2010
(while l
(
(lambda ( i )
(while (< 0 i)
(setq a (cons (car l) a) l (cdr l) i (1- i))
)
(setq b (cons (reverse a) b) a nil)
)
n
)
)
(reverse b)
)
;;---------------------=={ Unique }==-------------------------;;
;; ;;
;;Returns a list containing distinct elements ;;
;;------------------------------------------------------------;;
;;Author: Lee McDonnell, 2010 ;;
;; ;;
;;Copyright ?2010 by Lee McDonnell, All Rights Reserved. ;;
;;Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;lst - List to process ;;
;;------------------------------------------------------------;;
;;Returns: List in which no element appears more than once;;
;;------------------------------------------------------------;;
(defun LM:unique ( lst )
;; ?Lee Mac 2010
(if lst
(cons (car lst)
(LM:unique (vl-remove (car lst) lst))
)
)
)
这才是好人 不做评论。。。
其实这个程序在外国网早就见过。没想到有人拿回来要B. 呵呵，之前我一直认为明经币只是论坛的一种动力币而已，所以只要是好的资料，不管是自己写的或者是收集到的，都可以收点币。
但现在发现，大家对明经币的要求相当高，不是自己的作品，只能共享，不能收费。
如果这样，以后的政策将做进一步调整了。 5楼正解 我觉得优秀程序适当收点虚拟币也是正常的，毕竟别人也是从别处花时间“淘”来的，当然了不收币那是最好不过的。明经币可以通过论坛的贡献、积分、金钱兑换，1个明经币也就是回几个帖而已！支持论坛才是最关键的！
支持楼主能够站出来。。。。。。
(defun LM:unique ( lst )
;; ?Lee Mac 2010
(if lst
(cons (car lst)
(LM:unique (vl-remove (car lst) lst))
)
)
)
支持！上面的循环方式不错，短小精干。 本帖最后由 LLL2011 于 2012-3-6 15:40 编辑
个人观点：
论坛应形成：明经币少的不一定水平低，但明经币多绝对水平高。
如果涉及版权问题要深究.