明总，是否允许拿别人的程序卖钱？？？

LLL2011 · 发表于 2012-3-6 12:34:36

各版主,我发现有的人拿别人的程序卖钱，本人认为这是不道德的。
不知版主们对此观点如何？？？
附别人的：（激光镜面反射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))
)
)
)

;|         ;; 
 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)) 
    ) 
  ) 
)

cabinsummer · 发表于 2012-3-6 12:42:25

这才是好人

LLXXZZ · 发表于 2012-3-6 12:44:30

不做评论。。。

429014673 · 发表于 2012-3-6 13:04:28

其实这个程序在外国网早就见过。没想到有人拿回来要B.

mccad · 发表于 2012-3-6 13:37:15

呵呵，之前我一直认为明经币只是论坛的一种动力币而已，所以只要是好的资料，不管是自己写的或者是收集到的，都可以收点币。
但现在发现，大家对明经币的要求相当高，不是自己的作品，只能共享，不能收费。
如果这样，以后的政策将做进一步调整了。

puzb2001 · 发表于 2012-3-6 13:39:53

5楼正解

仲文玉 · 发表于 2012-3-6 14:21:39

我觉得优秀程序适当收点虚拟币也是正常的，毕竟别人也是从别处花时间“淘”来的，当然了不收币那是最好不过的。明经币可以通过论坛的贡献、积分、金钱兑换，1个明经币也就是回几个帖而已！支持论坛才是最关键的！

支持楼主能够站出来。。。。。。

snddd2000 · 发表于 2012-3-6 15:04:12

(defun LM:unique ( lst )
  ;; ?Lee Mac 2010
  (if lst
(cons (car lst)
   (LM:unique (vl-remove (car lst) lst))
)
  )
)
支持！上面的循环方式不错，短小精干。

LLL2011 · 发表于 2012-3-6 15:38:54

本帖最后由 LLL2011 于 2012-3-6 15:40 编辑

个人观点：
论坛应形成：明经币少的不一定水平低，但明经币多绝对水平高。

缘份呐 · 发表于 2012-3-6 18:27:11

如果涉及版权问题要深究.

账号		自动登录	找回密码
密码			注册

明总，是否允许拿别人的程序卖钱？？？

点评

评分

相关帖子

点评