画出如图的蛇形LINE图形

newer

朋友给我张图片，



大家试试写下代码，


四个交互参数
1、圆心、
2、半径
3、等分数
4、尖角水平距离


起始点和结束点可以用圆包围盒矩形的两端点。

aimisiyou

加点奖励更好

newer

aimisiyou 发表于 2016-10-20 12:39

哈，能正确画出的代码，老大奖励50个豆

q3_2006

这用来干嘛的??

HLCAD

楼上的真厉害！

XDSoft

q3_2006 发表于 2016-10-20 15:15

代码贴上来吧。每天动手写100行代码，预防痴呆:)

q3_2006

(defun c:tt (/          a    aa   ax         b    box  dx        ff   la          lx   msg
             n          odlst            p         pl   pt   pts        px   x          y    mkcir
             mkline    ebox 2epi 2pdf dxf  mid
            )
  (progn
    (defun mkcir (pt r la)
      (entmakex
        (list '(0 . "CIRCLE") (cons 8 la) (cons 10 pt) (cons 40 r))
      )
    )
    (defun mkline (sp ep la)
      (entmakex
        (list '(0 . "LINE") (cons 8 la) (cons 10 sp) (cons 11 ep))
      )
    )
    (defun eBox        (ent / ll ur)
      (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
      (mapcar 'safearray-value (list ll ur))
    )
    (defun 2epi        (e1 e2 mode / l r)
      (setq obj1 (vlax-ename->vla-object e1)
            obj2 (vlax-ename->vla-object e2)
            l         (vlax-invoke obj1 'intersectwith obj2 mode)
      )
      (repeat (/ (length l) 3)
        (setq r        (cons (list (car l) (cadr l) (caddr l)) r)
              l        (cdddr l)
        )
      )
      (reverse r)
    )
    (defun 2pdf        (p1 p2 n / an d dx l)
      (setq d  (distance p1 p2)
            an (angle p1 p2)
            dx (/ d n)
            l  nil
            l  (cons p1 l)
            l  (reverse        (repeat        n
                          (setq        p1 (polar p1 an dx)
                                l  (cons p1 l)
                          )
                        )
               )
      )
    )
    (defun mid (p1 p2)
      (mapcar (function (lambda (e1 e2) (* (+ e1 e2) 0.5))) p1 p2)
    )
    (defun dxf (key ename) (cdr (assoc key (entget ename))))
  )
  (vl-load-com)
  (setq        *ACAD* (vlax-get-acad-object)
        *DOC*  (vla-get-ActiveDocument *ACAD*)
  )
  (defun *error* (msg)
    (mapcar 'setvar '("cmdecho" "osmode") odlst)
    (vlax-invoke-method *DOC* 'EndUndoMark)
    (princ msg)
  )
  (vlax-invoke-method *DOC* 'StartUndoMark)
  (setq odlst (mapcar 'getvar '("cmdecho" "osmode")))
  (mapcar 'setvar '("cmdecho" "osmode") '(0 0))
  (if (not *rr)
    (setq *rr 100.)
  )
  (if (not *nn)
    (setq *nn 11)
  )
  (if (not *d1)
    (setq *d1 10.)
  )
  (setq ff t)
  (while (and ff (setq pt (getpoint "\n点取圆心:")))
    (if        pt
      (progn
        (setq *rr
               (cond
                 ((getreal (strcat "\n输入半径 <" (rtos *rr 2 2) ">: "))
                 )
                 (*rr)
               )
        )
        (setq *nn
               (cond
                 ((getint (strcat "\n输入等分数量 <" (itoa *nn) ">: ")))
                 (*nn)
               )
        )
        (setq *d1
               (cond
                 ((getreal
                    (strcat "\n输入尖角水平距离 <" (rtos *d1 2 2) ">: ")
                  )
                 )
                 (*d1)
               )
        )
        (setq la  "0"
              aa  (mkcir pt *rr la)
              box (ebox aa)
              pts (2pdf (car box) (cadr box) *nn)
              dx  (+ *rr *d1)
              lx  (mapcar '(lambda (x)
                             (setq p  (list (car pt) (cadr x))
                                   ax (mkline (polar p pi dx) (polar p 0 dx) la)
                                   pl (2epi ax aa 0)
                                   pl (if pl
                                        (vl-sort pl
                                                 '(lambda (a b) (< (car a) (car b)))
                                        )
                                      )
                             )
                             (cond
                               ((and (not pl) (equal (car box) x 1e-4))
                                (Vlax-Put-Property
                                  (Vlax-Ename->Vla-Object ax)
                                  'EndPoint
                                  (Vlax-3d-Point p)
                                )
                               )
                               ((and (not pl) (equal (cadr box) x 1e-4))
                                (if (= 1 (rem *nn 2))
                                  (progn
                                    (Vlax-Put-Property
                                      (Vlax-Ename->Vla-Object ax)
                                      'StartPoint
                                      (Vlax-3d-Point
                                        (list (caar box) (cadadr box))
                                      )
                                    )
                                    (Vlax-Put-Property
                                      (Vlax-Ename->Vla-Object ax)
                                      'EndPoint
                                      (Vlax-3d-Point p)
                                    )
                                  )
                                  (Vlax-Put-Property
                                    (Vlax-Ename->Vla-Object ax)
                                    'StartPoint
                                    (Vlax-3d-Point p)
                                  )
                                )
                               )
                               (t
                                (Vlax-Put-Property
                                  (Vlax-Ename->Vla-Object ax)
                                  'StartPoint
                                  (Vlax-3d-Point (car pl))
                                )
                                (Vlax-Put-Property
                                  (Vlax-Ename->Vla-Object ax)
                                  'EndPoint
                                  (Vlax-3d-Point (cadr pl))
                                )
                               )
                             )
                             ax
                           )
                          pts
                  )
        )
        (mapcar        '(lambda (x y)
                   (setq n (1+ (vl-position x lx)))
                   (if (= 1 (rem n 2))
                     (progn
                       (setq p (if (> (car (dxf 11 x)) (car (dxf 11 y)))
                                 (dxf 11 x)
                                 (dxf 11 y)
                               )
                       )
                       (Vlax-Put-Property
                         (Vlax-Ename->Vla-Object x)
                         'EndPoint
                         (Vlax-3d-Point (list (car p) (cadr (dxf 11 x))))
                       )
                       (Vlax-Put-Property
                         (Vlax-Ename->Vla-Object y)
                         'EndPoint
                         (Vlax-3d-Point (list (car p) (cadr (dxf 11 y))))
                       )
                       (setq px        (polar (mid (dxf 11 x) (dxf 11 y)) 0 *d1)
                             ax        (mkline (dxf 11 x) px la)
                             ax        (mkline (dxf 11 y) px la)
                       )
                     )
                     (progn
                       (setq p (if (< (car (dxf 10 x)) (car (dxf 10 y)))
                                 (dxf 10 x)
                                 (dxf 10 y)
                               )
                       )
                       (Vlax-Put-Property
                         (Vlax-Ename->Vla-Object x)
                         'StartPoint
                         (Vlax-3d-Point (list (car p) (cadr (dxf 10 x))))
                       )
                       (Vlax-Put-Property
                         (Vlax-Ename->Vla-Object y)
                         'StartPoint
                         (Vlax-3d-Point (list (car p) (cadr (dxf 10 y))))
                       )
                       (setq px        (polar (mid (dxf 10 x) (dxf 10 y)) pi *d1)
                             ax        (mkline (dxf 10 x) px la)
                             ax        (mkline (dxf 10 y) px la)
                       )
                     )
                   )
                 )
                lx
                (cdr lx)
        )
      )
      (setq ff nil)
    )
  )
  (mapcar 'setvar '("cmdecho" "osmode") odlst)
  (vlax-invoke-method *DOC* 'EndUndoMark)
)

XDSoft

HLCAD 发表于 2016-10-20 16:28

你也来一个啊。

Lispboy

凑个热闹，

(defun XD::List:GroupByNum (lst num / ls ret)
  (if (= (rem (length lst) num) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
        (repeat num
          (setq ls (cons (car lst) ls)
                lst (cdr lst)
          )
        )
        (setq ret (append
                    ret
                    (list (reverse ls))
                  )
              ls nil
        )
      )
    )
  )
  ret
)

(defun c:tt ()
  (defun _setelev (pt elev)
    (list (car pt) (cadr pt) elev)
  )
  ;;;;;;;;;;;;;;;;;;;;;
  (defun _drawPolyline (pts)
    (setq pts (mapcar
                '(lambda (x)
                   (list (car x) (cadr x))
                 )
                pts
              )
    )
    (setq points (vlax-make-safearray vlax-vbDouble (cons 0 (1- (* 2
                                                                   (length pts)
                                                                )
                                                            )
                                                    )
                 )
    )
    (vlax-safearray-fill points (apply
                                  'append
                                  pts
                                )
    )
    (setq plineObj (vla-AddLightWeightPolyline ms points))
  )
  ;;;;;;;;;;;;;;;;;;;;;
  (defun _drawline ()
    (setq line (vlax-invoke ms 'addline first extMax)
          ang (angle first extmax)
          templen 0.
    )
    (setq i 0)
    (repeat #div
      (setq lineObj (vla-Offset line (* (setq i (1+ i))
                                        offsetdist
                                     )
                    )
            lineObj (car (vlax-safearray->list (vlax-variant-value lineObj)))
            intPoints (vlax-Invoke lineObj 'IntersectWith circleObj
                                   acExtendboth
                      )
            ints (XD::List:GroupByNum intPoints 3)
      )
      (if (not (equal ang (apply
                            'angle
                            ints
                          ) 1
               )
          )
        (setq ints (reverse ints))
      )
      (if (= (rem i 2) 0)
        (setq ept (car ints)
              ints (list (last ints) ept)
              an1 (* 3 (/ pi 4))
              an2 pi
        )
        (setq ept (last ints)
              an1 (/ pi 2)
              an2 0
        )
      )
      (if (> (apply
               'distance
               ints
             ) templen
          )
        (progn
          (setq mid (polar (polar ept (/ pi 2) (/ (abs offsetdist) 2.0)) an2
                           #dis
                    )
                p2 (polar ept (/ pi 2) (abs offsetdist))
          )
        )
        (progn
          (setq p2 (car temp)
                mid (polar (polar p2 (- (/ pi 2.0)) (/ (abs offsetdist) 2.0))
                           an2 #dis
                    )
                ept (polar p2 (- (/ pi 2)) (abs offsetdist))
          )
        )
      )
      (setq pts (cons p2 pts)
            pts (cons mid pts)
            pts (cons ept pts)
            temp ints
            templen (apply
                      'distance
                      ints
                    )
      )
      (vla-delete lineobj)
    )
    (vla-delete line)
    (if (= (rem #div 2) 0)
      (setq pts (cons end pts))
      (setq pts (cons extmin pts))
    )
    (_drawPolyline pts)
  )
  ;;;;;;;;;;;;;;;;;;;;;
  (defun _drawcircle ()
    (setq circleObj (vla-addcircle ms (vlax-3d-point #cen) #r)
          offsetdist (- (/ (* 2 #r) #div))
    )
    (vla-getboundingbox circleobj 'extMin 'extMax)
    (setq extMin (_setelev (vlax-safearray->list extMin) 0.0)
          extMax (_setelev (vlax-safearray->list extMax) 0.0)
          first (list (car extmin) (cadr extmax) 0.0)
          end (list (car extmax) (cadr extmin) 0.0)
          pts (list first)
    )
    (_drawline)
  )
  ;;;;;;;;;;;;;;;;;;;;;
  (if (not #r)
    (setq #r 100)
  )
  (if (not #dis)
    (setq #dis 10)
  )
  (if (setq r (getreal (strcat "\n半径<" (vl-prin1-to-string #r) ">:")))
    (setq #r r)
  )
  (if (setq dis (getreal (strcat "\n尖角水平距离<"
                                 (vl-prin1-to-string #dis) ">:"
                         )
                )
      )
    (setq #dis dis)
  )
  (setq doc (vla-get-activedocument (vlax-get-acad-object))
        ms (vla-get-modelspace doc)
  )
  (vlax-invoke-method doc 'StartUndoMark)
  (while (and
           (setq #div (getint "\n等分数<退出>:"))
           (setq #cen (getpoint "\n圆心<退出>"))
         )
    (_drawcircle)
  )
  (vlax-invoke-method doc 'EndUndoMark)
  (princ)
)

aimisiyou

;;;来个半成品

;;;来个半成品
(defun c:tt ()
  (defun f (ptc k flag h d)
    (if        (= (rem k 2) 0)
      (setq cn -0.5)
      (setq cn 0.5)
    )
    (setq
      pt1 (list (car ptc) (+ (cadr ptc) (* (+ k -1 (* flag 0.5)) h)))
    )
    (setq dl (distance pt1 ptc))
    (setq
      pt2 (polar pt1 (* (+ 0.5 cn) pi) (sqrt (- (* r r) (* dl dl))))
    )
    (setq pt3 (list (+ (car pt2) (* -2 cn d)) (+ (cadr pt2) (* 0.5 h))))
    (setq pt4 (list (car pt2) (+ (cadr pt2) h)))
    (setq pt5 (list (car pt1) (+ (cadr pt1) h)))
    (command "line" pt1 pt2 pt3 pt4 pt5 "")
  )
  (setvar "osmode" 0)
  (setq        ptc (getpoint "\n圓心：")
        r   (getreal "\n半徑：")
        n   (getint "\n等分數:")
        d   (getreal "\n尖角長度:")
  )
  (command "circle" ptc r)
  (if (= (rem n 2) 0)
    (setq flag 0)
    (setq flag 1)
  )
  (setq h (/ (* 2.0 r) n))
  (setq        i 1
        j 1
  )
  (while (<= i (/ n 2))
    (f ptc i flag h d)
    (setq i (+ 1 i))
  )
  (setq ptlast (polar ptc (/ pi 2) r))
  (if (= (rem (/ n 2) 2) 0)
    (setq co 1)
    (setq co 0)
  )
  (command "line" ptlast (polar ptlast (* co pi) r) "")
)

XDSoft

aimisiyou 发表于 2016-10-20 23:47

加油，早日完成，主要在下半段的尖角。

q3_2006

Lispboy 发表于 2016-10-20 18:15

这个要学习...我要先看懂..消化一下...

lj524917100

确实是难得好帖啊，顶先

434939575

好东西，学习了！谢谢各位！

aimisiyou

XDSoft 发表于 2016-10-21 01:22

(defun c:tt ()  (defun drawline (pt1 pt2)
    (entmakex (list '(0 . "LINE") (cons 8 "0") (cons 10 pt1) (cons 11 pt2)))
  )
  (defun f (ptc k flag h d)
    (if (= (rem k 2) 0)
      (setq cn -0.5)
      (setq cn 0.5)
    )
    (setq pt1 (list (car ptc) (+ (cadr ptc) (* (+ k -1 (* flag 0.5)) h))))
    (if (> k 0)
      (setq dl (distance pt1 ptc)
            cm -1
      )
      (setq dl (distance (polar pt1 (/ pi 2) h) ptc)
            cm 0
      )
    )
    (setq pt2 (polar pt1 (* (- 1.5 cn) pi) (sqrt (- (* r r) (* dl dl)))))
    (setq pt3 (list (+ (car pt2) (* -2 cn d)) (+ (cadr pt2) (* 0.5 h))))
    (setq pt4 (list (car pt2) (+ (cadr pt2) h)))
    (setq pt5 (list (car pt1) (+ (cadr pt1) h)))
    (drawline pt1 pt2)
    (drawline pt2 pt3)
    (drawline pt3 pt4)
    (drawline pt4 pt5)
  )
  (setvar "osmode" 0)
  (setq ptc (getpoint "\n圓心：")
        r (getreal "\n半徑：")
        n (getint "\n等分數:")
        d (getreal "\n尖角長度:")
  )
  (command "circle" ptc r)
  (if (= (rem n 2) 0)
    (setq flag 0)
    (setq flag 1)
  )
  (setq h (/ (* 2.0 r) n))
  (setq i (/ n 2))
  (while (and
           (<= i (/ n 2))
           (>= i (/ (- n 1) -2))
         )
    (f ptc i flag h d)
    (setq i (- i 1))
  )
  (setq ptu (polar ptc (* pi 0.5) r))
  (setq ptlu (polar ptu pi r))
  (setq ptru (polar ptu 0 r))
  (setq ptd (polar ptc (* pi 1.5) r))
  (setq ptld (polar ptd pi r))
  (setq ptrd (polar ptd 0 r))
  (if (= (rem n 2) 0)
    (if (= (rem (/ n 2) 2) 0)
      (progn
        (drawline ptlu ptu)
        (drawline ptd ptrd)
      )
      (progn
        (drawline ptu ptru)
        (drawline ptld ptd)
      )
    )
    (if (= (rem (/ n 2) 2) 0)
      (progn
        (drawline ptlu ptu)
        (drawline ptld ptd)
      )
      (progn
        (drawline ptu ptru)
        (drawline ptd ptrd)
      )
    )
  )
)