[练习]AutoLISP参数化设计

sdh142857

你对AutoLISP参数化设计感兴趣吗,这是一个五角星绘制程序.
(defun DTR(X)
  (* X (/ pi 180.0))
)

(defun WJX(R)
  (setq P0 '(100 100) 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")
)

请练习一下,看谁能编写更巧妙,简洁或者有个人特色的程序.

奎容阁

改了一下，不过大同小异，呵呵：
(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")
)

[ 本帖最后由 奎容阁 于 2006-12-15 13:19 编辑 ]

奎容阁

方法二：
(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)
)

[ 本帖最后由 奎容阁 于 2006-12-15 16:38 编辑 ]

奎容阁

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

sdh142857

楼上真不简单!VLA-功能是Visual LISP的扩展功能,运用得这么好!

对刚入门的朋友提醒一下,这些功能要在运行(vl-load-com)之后才能用哦.

奎容阁

呵呵，是的，要加上(vl-load-com)
已经编辑了一下。

sdh142857

不用Command函数,使用Entmake函数创建实体,代码如下

(defun DTR(X)
  ;;角度转弧度
  (* X (/ pi 180.0))
)

(defun Add_LwPline(PntLst C /  EntLst)
  ;;创建多段线,PntLst顶点表,C封闭为1开放为0
  (setq EntLst (append '((0 . "LWPOLYLINE")
             (100 . "AcDbEntity")
             (100 . "AcDbPolyline")
             )
           (list (cons 90 (length pntlst))
                 (cons 70 C))
           (mapcar '(lambda (x) (cons 10 x)) PntLst)
           ))
  (entmake EntLst)
             
)


(defun WJX(P0 R / DA P1 P2 P3 P4 P5)
  ;;绘制五角星,P0为中心点,R为半径
  (setq 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)
    )
  (Add_LwPline (list p1 p3 p5 p2 p4) 1)
)

;;以下调用WXJ函数
(WJX '(64 150) 12)
(WJX '(90.6 158.7) 5)
(WJX '(90.0 139.5) 5)
(WJX '(77.1 125.3) 5)
(WJX '(58.2 122.6) 5)
(Add_LwPline '((40 170)(190 170) (190 80)(40 80)) 1)

奎容阁

方法四：不用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)
)