Author Topic: Is these three dynamic display(lwpolyline) function possible be realized in Lisp  (Read 13720 times)

0 Members and 1 Guest are viewing this topic.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Hi:)

Is this dynamic display function possible be realized in Lisp

The following picture show one steel bar drawing program, I think it is mainly wrote by ARX. I wonder whether these is possible wrote by lisp

1) dynamic steel bar with hook polyline drawing, pick first point, then dynamic show until the second point selected.

2) add hook, dynamic add hook, use mouse to decide with side the hook is added

3) dynamic offset a polyline: select one polyline, when move the mouse, dynamic show the new offset polyline.

Thank you very much and sorry that I cant turn the language from Chinese to English

« Last Edit: September 29, 2006, 10:16:07 AM by yuanqiu »
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Hi:)

Is this dynamic display function possible be realized in Lisp

The following picture show one steel bar drawing program, I think it is mainly wrote by ARX. I wonder whether these is possible wrote by lisp

1) dynamic steel bar with hook polyline drawing, pick first point, then dynamic show until the second point selected.

2) add hook, dynamic add hook, use mouse to decide with side the hook is added

3) dynamic offset a polyline: select one polyline, when move the mouse, dynamic show the new offset polyline.

Thank you very much and sorry that I cant turn the language from Chinese to English



Yes, it is possible!  :-)

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
help me, Evgeniy, your clock and 3dorbit and polyline change width and polyline section from line to arc rountine do show dynamic effect:)
please give me a way, thank you~
« Last Edit: September 29, 2006, 07:54:43 PM by yuanqiu »
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
help me, Evgeniy, your clock and your 3dorbit rountine do show dynamic effect:)
please give me a way, thank you~
Unfortunately I do not have now time, to make all completely...
Code: [Select]
(defun c:test (/ A D E GR LST LST1 LST2 )
      (setq
        e    (entmakex
               '((0 . "LWPOLYLINE")
                 (100 . "AcDbEntity")
                 (67 . 0)
                 (410 . "Model")
                 (8 . "0")
                 (62 . 1)
                 (100 . "AcDbPolyline")
                 (90 . 5)
                 (70 . 0)
                 (43 . 10.0)
                 (38 . 0.0)
                 (39 . 0.0)
                 (10 50.0 20.0)
                 (42 . 0.0)
                 (10 0. 20.0)
                 (42 . 1.0)
                 (10 0. 0.0)
                 (42 . 0.0)
                 (10 0.0 0.0)
                 (42 . 1.0)
                 (10 0.0 20.0)
                 (42 . 0.0)
                 (10 -50. 20.0)
                 (42 . 0.0)
                 (210 0.0 0.0 1.0)
                )
             ) ;_  entmakex
        lst1 '((50. 20.)
                 (0. 20.)
                 (0. 0.)
                )
        lst2 '((0. 0.)
                 (0. 20.)
                 (-50. 20.)
                )
        e    (reverse (vl-member-if
                        (function
                          (lambda (x)
                            (= (car x) 39)
                          ) ;_  lambda
                        ) ;_  function
                        (reverse (entget e))
                      ) ;_  vl-member-if
             ) ;_  reverse
      ) ;_  setq
      (while (= (car (setq gr (grread nil 5 1))) 5)
        (setq a (angle '(0. 0. 0.) (cadr gr))
              d (distance '(0. 0. 0.) (cadr gr))
        ) ;_  setq
        (setq
          lst (append
                (mapcar
                  (function
                    (lambda (p)
                      (list
                        (+ (* (car p) (cos a))
                           (* (cadr p) (- (sin a)))
                        ) ;_  list
                        (+ (* (car p) (sin a))
                           (* (cadr p) (cos a))
                        ) ;_  list
                      ) ;_  list
                    ) ;_  lambda
                  ) ;_  function
                  lst1
                ) ;_  mapcar
                (mapcar
                  (function
                    (lambda (p)
                      (list
                        (+ (* (+ d (car p)) (cos a))
                           (* (cadr p) (- (sin a)))

                        ) ;_  list
                        (+ (* (+ d (car p)) (sin a))
                           (* (cadr p) (cos a))

                        ) ;_  list
                      ) ;_  list
                    ) ;_  lambda
                  ) ;_  function
                  lst2
                ) ;_  mapcar
              ) ;_  append
        ) ;_  setq
        (entmod
          (append
            e
            (list
              (cons 10 (car lst))
              '(42 . 0.)
              (cons 10 (cadr lst))
              '(42 . 1.)
              (cons 10 (caddr lst))
              '(42 . 0.)
              (cons 10 (cadddr lst))
              '(42 . 1.)
              (cons 10 (nth 4 lst))
              '(42 . 0.)
              (cons 10 (nth 5 lst))
              '(42 . 0.)
            ) ;_  list
          ) ;_  append
        ) ;_  entmod
      ) ;_  while
  (princ)
)

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Thank you, Evgeniy, great, it do realize the first effect. I dont know that the grread and entmod can realize so funny work.
I change very little to get the first point which different from (0. 0. 0.), I hope you dont mind  :-D
and I am not sure why the reverse used.
I will try to wrote the other effect, but I do need your help.
Code: [Select]
;;by ElpanovEvgeniy at theswamp.org
;;change very little by qjchen
(defun c:test (/ A D E GR LST LST1 LST2 pt)
  (setq pt (getpoint "\nthe steel start point:"))
  (setq
    e
         (entmakex
           '((0 . "LWPOLYLINE")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (8 . "0")
             (62 . 1)
             (100 . "AcDbPolyline")
             (90 . 5)
             (70 . 0)
             (43 . 10.0)
             (38 . 0.0)
             (39 . 0.0)
             (10 50.0 20.0)
             (42 . 0.0)
             (10 0. 20.0)
             (42 . 1.0)
             (10 0. 0.0)
             (42 . 0.0)
             (10 0.0 0.0)
             (42 . 1.0)
             (10 0.0 20.0)
             (42 . 0.0)
             (10 -50. 20.0)
             (42 . 0.0)
             (210 0.0 0.0 1.0)
            )
         ) ;_  entmakex
    lst1 '((50. 20.)
           (0. 20.)
           (0. 0.)
          )
    lst2 '((0. 0.)
           (0. 20.)
           (-50. 20.)
          )
    e
         (reverse (vl-member-if
                    (function
                      (lambda (x)
                        (= (car x) 39)
                      ) ;_  lambda
                    ) ;_  function
                    (reverse (entget e))
                  ) ;_  vl-member-if
         ) ;_  reverse
  ) ;_  setq
  (while (= (car (setq gr (grread nil 5 1))) 5)
    (setq a (angle pt (cadr gr))
          d (distance pt (cadr gr))
    )
    (setq
      lst (append
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (car p) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (car p) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst1
            ) ;_  mapcar
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (+ d (car p)) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (+ d (car p)) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst2
            ) ;_  mapcar
          ) ;_  append
    ) ;_  setq
    (entmod
      (append
        e
        (list
          (cons 10 (car lst))
          '(42 . 0.)
          (cons 10 (cadr lst))
          '(42 . 1.)
          (cons 10 (caddr lst))
          '(42 . 0.)
          (cons 10 (cadddr lst))
          '(42 . 1.)
          (cons 10 (nth 4 lst))
          '(42 . 0.)
          (cons 10 (nth 5 lst))
          '(42 . 0.)
        ) ;_  list
      ) ;_  append
    ) ;_  entmod
  ) ;_  while
  (princ)
)


« Last Edit: September 29, 2006, 08:58:21 PM by yuanqiu »
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)

Thank you, Evgeniy, great, it do realize the first effect. I dont know that the grread and entmod can realize so funny work.
I change very little to get the first point which different from (0. 0. 0.), I hope you dont mind  :-D
and I am not sure why the reverse used.
I will try to wrote the other effect, but I do need your help.


Yesterday, I had a difficult day and I am very much tired...
At your request I have made the small beginning, for an illustration.

Today, I shall help you with other items, it is not complex :)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)

;;change very little by qjchen


I congratulate!
You have perfectly finished the program (1), it was pleasant to me!
 :-) :-) :-)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
I have decided to skip while the second task - it the most simple...
Look solution of the third task.

Code: [Select]
(defun c:test (/ A D D0 E EN GR LST LST1 LST2 PT)
  ;;by ElpanovEvgeniy at theswamp.org
  ;;change very little by qjchen

  ;; The last changes
  ;; The task (3) is solved
 
  (setq pt (getpoint "\nthe steel start point:"))
  (setq
    en
         (entmakex
           '((0 . "LWPOLYLINE")
             (100 . "AcDbEntity")
             (67 . 0)
             (410 . "Model")
             (8 . "0")
             (62 . 1)
             (100 . "AcDbPolyline")
             (90 . 5)
             (70 . 0)
             (43 . 10.0)
             (38 . 0.0)
             (39 . 0.0)
             (10 50.0 20.0)
             (42 . 0.0)
             (10 0. 20.0)
             (42 . 1.0)
             (10 0. 0.0)
             (42 . 0.0)
             (10 0.0 0.0)
             (42 . 1.0)
             (10 0.0 20.0)
             (42 . 0.0)
             (10 -50. 20.0)
             (42 . 0.0)
             (210 0.0 0.0 1.0)
            )
         ) ;_  entmakex
    lst1 '((50. 20.)
           (0. 20.)
           (0. 0.)
          )
    lst2 '((0. 0.)
           (0. 20.)
           (-50. 20.)
          )
    e
         (reverse (vl-member-if
                    (function
                      (lambda (x)
                        (= (car x) 39)
                      ) ;_  lambda
                    ) ;_  function
                    (reverse (entget en))
                  ) ;_  vl-member-if
         ) ;_  reverse
  ) ;_  setq
  (while (= (car (setq gr (grread nil 5 1))) 5)
    (setq a (angle pt (cadr gr))
          d (distance pt (cadr gr))
    ) ;_  setq
    (setq
      lst (append
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (car p) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (car p) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst1
            ) ;_  mapcar
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (* (+ d (car p)) (cos a))
                       (* (cadr p) (- (sin a)))
                       (car pt)
                    ) ;_  list
                    (+ (* (+ d (car p)) (sin a))
                       (* (cadr p) (cos a))
                       (cadr pt)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst2
            ) ;_  mapcar
          ) ;_  append
    ) ;_  setq
    (entmod
      (append
        e
        (list
          (cons 10 (car lst))
          '(42 . 0.)
          (cons 10 (cadr lst))
          '(42 . 1.)
          (cons 10 (caddr lst))
          '(42 . 0.)
          (cons 10 (cadddr lst))
          '(42 . 1.)
          (cons 10 (nth 4 lst))
          '(42 . 0.)
          (cons 10 (nth 5 lst))
          '(42 . 0.)
        ) ;_  list
      ) ;_  append
    ) ;_  entmod
  ) ;_  while
  (setq
    pt   (mapcar (function -) (cadr lst) (caddr lst))
    a    (angle (caddr lst) (cadr lst))
    d0   (distance (cadr lst) (caddr lst))
    lst1 (list (car lst) (cadr lst) (nth 4 lst) (nth 5 lst))
    lst2 (list (caddr lst) (cadddr lst))
  ) ;_  setq
  (setq en (entmakex (entget en)))
  (while (= (car (setq gr (grread nil 5 0))) 5)
    (setq d (polar pt
                   a
                   (-
                     (distance (cadr gr)
                               (vlax-curve-getClosestPointTo
                                 en
                                 (cadr gr)
                               ) ;_  vlax-curve-getClosestPointTo
                     ) ;_  distance
                     d0
                   ) ;_  -
            ) ;_  polar
    ) ;_  setq
    (setq
      lst (append
            (mapcar
              (function
                (lambda (p)
                  (list
                    (+ (car p)
                       (car d)
                    ) ;_  list
                    (+ (cadr p)
                       (cadr d)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst1
            ) ;_  mapcar
            (mapcar
              (function
                (lambda (p)
                  (list
                    (- (car p)
                       (car d)
                    ) ;_  list
                    (- (cadr p)
                       (cadr d)
                    ) ;_  list
                  ) ;_  list
                ) ;_  lambda
              ) ;_  function
              lst2
            ) ;_  mapcar
          ) ;_  append
    ) ;_  setq
    (entmod
      (append
        e
        (list
          (cons 10 (car lst))
          '(42 . 0.)
          (cons 10 (cadr lst))
          '(42 . 1.)
          (cons 10 (nth 4 lst))
          '(42 . 0.)
          (cons 10 (nth 5 lst))
          '(42 . 1.)
          (cons 10 (caddr lst))
          '(42 . 0.)
          (cons 10 (cadddr lst))
          '(42 . 0.)
        ) ;_  list
      ) ;_  append
    ) ;_  entmod
  ) ;_  while
  (princ)
)

PS. Change in my preparation, everything, that want!
I specially have named it TEST...
 :angel:

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Thank you, evgeniy, you are a expert:)

The third function realized~~.

Can I ask one more thing, if the function 2 and function 3 is for general lwpolyline, does this algorithm need to be changed?

At first, I think the function 3 may be like the following:

1) copy the original lwpolyline to a new one

2) while grread, offset the new one to a new new one and get the vertex then entdel the offset one

3) entmod the new one

but it seems too difficult and maybe the offset command will waste lot of cpu time.

I will try to learn your "offset like" function 3.

Thank you again:)
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
I have not understood...
Programs (2, 3) are necessary to you separately, for any polylines?

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Dear CHEN QING JUN
For me to you a counter question.
You use what program, for creation of beautiful presentation of programs (*.GIF)?
I too would like to do similar, only methods known to me - borrow a lot of time...

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Evgeniy,
probably SNAGIT from TechSmith
http://www.techsmith.com/snagit.asp
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Dear evgeniy


snagit that kerry brown introduce is a very good software.

and I use the software gif.gif.gif, a very small software

http://www.peda.com/ggg/

it can capture the screen video to gif format, 256 color.

Quote
I have not understood...
Programs (2, 3) are necessary to you separately, for any polylines?

yes, all this 3 functions is separately, and function (2,3) is for any polylines.

thank you
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Dear evgeniy


snagit that kerry brown introduce is a very good software.

It was pleasant to me, but for creation of animated picture GIF - the external program is necessary  :-(

and I use the software gif.gif.gif, a very small software

http://www.peda.com/ggg/

it can capture the screen video to gif format, 256 color.
To me has very much liked it was pleasant, fast, simple and easy :)

yes, all this 3 functions is separately, and function (2,3) is for any polylines.

thank you

Tonight, I shall find time to write clone OFFSET in the simplified variant, but for any line and with dynamics...
Most likely, I shall not consider possible self-intersections.
« Last Edit: September 30, 2006, 09:52:59 AM by ElpanovEvgeniy »

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Dear Evgeniy

With your great help, I write one rountine to realize the function 3,

though the code is not so tidy, but it can work

I will go out for about 4~5 days and cant go here, if I cant reply on time, forgive me

Code: [Select]
;; Great thanks to Evgeniy at www.theswamp.org              ;
;; Without his help, I dont know how the dynamic effect     ;
;; The following code take many from Evgeniy's code         ;
;; some of the following code is writen by qjchen              ;
(defun c:test1 (/ en en1 e ent1 gr d pt_res)
  (prompt "\n please select a polyline")
  (setq en (car (entsel)))
  (command "copy" en "" '(0. 0. 0.) '(0. 0. 0.))
  (setq en1 (entlast)
        e   (reverse (vl-member-if
                       (function (lambda (x)
                                   (= (car x) 39)
                                 ) ;_  lambda
                       ) ;_  function
                       (reverse (entget en1))
                     ) ;_  vl-member-if
            )
  )
  (setq ent1 (entget en))
  (while (= (car (setq gr (grread nil 5 0))) 5)
    (setq d (distance (cadr gr)
                      (vlax-curve-getClosestPointTo
                        en
                        (cadr gr)
                      ) ;_  vlax-curve-getClosestPointTo
            ) ;_  distance

    )
    (setq pt_res (myoffset en (cadr gr) d))
    (entmod_pline e pt_res)
    )
)

;;;;offset new lwpolyline and get the vertex           ;
(defun myoffset (ename pt dist / newent new res1)
  (command "offset" dist ename pt "")
  (setq new (entlast))
  (setq newent (entget new))
  (setq res1 (w_pl_lst newent))
  (entdel new)
  res1
)

;;;;entmod new polyline by vertex and bulge list      ;
(defun entmod_pline (e lst)
  (entmod (append
    e
    lst
  )
  )
)

;;;;get the vertex and bulge list of a polyline       ;
(defun w_pl_lst (ent / pt_list bulge_list x i res)
  (foreach x ent
    (if (= (car x) 10)
      (setq pt_list (append
      (list (cdr x))
      pt_list
    )
      )
    )
    (if (= (car x) 42)
      (setq bulge_list (append
(list (cdr x))
bulge_list
       )
      )
    )
  )
  (setq pt_list (reverse pt_list))
  (setq bulge_list (reverse bulge_list))
  (setq i 0)
  (repeat (length pt_list)
    (setq res (append
res
(list (cons 10 (nth i pt_list)))
(list (cons 42 (nth i bulge_list)))
      )
    )
    (setq i (1+ i))
  )
  res
)




« Last Edit: October 05, 2006, 08:10:42 AM by yuanqiu »
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)