[LISP程序]：我收集的LISP程序源代码之一

dzwmy

好东西，有没有之二啊

yxb345

初学阶段，向前辈学习

reang

下载研究先！谢谢楼主

zctao1966

谢谢分享，可惜是英文，有时间写个备注更好！

lrh_2003

没有积分下不了 。。。。

njshf

积分用完了

further00

“最好为程序集编个目录”
严重同意，不过资料还是很不错的，十分感谢！

fei_1

我要多发贴赚币才能下载

zweil

最好为程序集编个目录

jackhhu

谢谢了，最近正在钻研LISP

sjy2005

是干什么的，每段最好有一注士

dong790518

在等待

olivefei

1、
(defun c:wjx (/ DA P0 P1 P2 P3 P4 P5 R)
(defun DTR (X)
  (* X (/ pi 180.0))
)
(setq     p0 (getpoint "\n指定原点：")
    R (getreal "\n指定半径：")
    DA (/ 360 5)
)
(setq     P1 (polar P0 (DTR 90) R)
    P2 (polar P0 (DTR (+ 90 DA)) R)
    P3 (polar P0 (DTR (+ 90 (* 2 DA))) R)
    P4 (polar P0 (DTR (+ 90 (* 3 DA))) R)
    P5 (polar P0 (DTR (+ 90 (* 4 DA))) R)
)
(command "PLINE" P1 P3 P5 P2 P4 "C")
)

2、
(vl-load-com)
(defun c:tt (/ P0 R XYPT)
(defun getlwpolylinepoints (ename / temp1 e elist)
  (mapcar '(lambda (e) (setq elist (cons (cdr e) elist)))
        (vl-remove-if-not '(lambda (temp1) (= 10 (car temp1))) (entget ename))
  )
  elist
)
(setq     p0 (getpoint "\n指定原点：")
    R (getreal "\n指定半径：")
)
(command "_polygon" "5" p0 "I" R)
(setq xyPt (getlwpolylinepoints (entlast)))
(vla-delete (vlax-ename->vla-object (entlast)))
(command "PLINE" (nth 0 xyPt) (nth 2 xyPt)(nth 4 xyPt) (nth 1 xyPt) (nth 3 xyPt) "c")
(princ)
)

3、
在我楼上的方法二中，可以把画的那个五边形的顶点改一下顺序（运用vla-put-Coordinates）就OK了。

4、
;;不用Command命令
;;先有如下几个通用函数：
(vl-load-com)
(defun divCrvPtsList (ent count / i startPara endPara Rtn)
(setq     startPara (vlax-curve-getStartParam ent)
    endPara       (vlax-curve-getEndParam ent)
    i       1
)
(repeat count
  (setq Rtn
      (append Rtn (list (vlax-curve-getPointAtParam ent (* (/ (- endPara startPara) count) i))))
  )
  (setq i (1+ i))
)
Rtn
)
(defun 3d->2d (3d)
(if (and
    (numberp (car 3d))
    (numberp (cadr 3d))
    )
  (list (float (car 3d)) (float (cadr 3d)))
  (list (float (atof (car 3d))) (float (atof (cadr 3d))))
)
)
(defun list->VariantArray (ptsList / ArraySapce SArray)
(setq     ArraySapce
      (vlax-make-safearray
      vlax-vbDouble
      (cons 0 (- (length ptsList) 1))
      )
)
(setq SArray (vlax-safearray-fill ArraySapce ptsList))
(vlax-make-variant SArray)
)
;;以下是主程序：
(defun c:tt (/ P0 R XYPT MSPACE okPL)
(vl-load-com)
(setq mSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq     p0 (getpoint "\n指定原点：")
    R (getreal "\n指定半径：")
)
(vla-addcircle mSpace (vlax-3d-point p0) R)
(setq     xyPt (mapcar
          '3d->2d
          (divCrvPtsList (entlast) 5)
        )
)
(vla-delete (vlax-ename->vla-object (entlast)))
(setq xyPt (apply 'append (list (nth 0 xyPt) (nth 2 xyPt) (nth 4 xyPt) (nth 1 xyPt) (nth 3 xyPt))))
(setq okPL(vla-addlightweightpolyline mSpace (list->VariantArray xyPt)))
(vla-put-Closed okPL :vlax-true)
(princ)
)

caogis

能列个目录，有各程序名称及功能就再好不过了

jac312

为什么不让我下呢