Solved: Re: continous polyline from bottom left and top right of rectangle

marlance · ‎09-29-2014

Is it possible to create a polyline from a multiple number of rectangle like this?

hmsilva · ‎09-30-2014

Perhaps something like this, untested...

(defun c:demo ( / make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (defun make_lw (pt_lst)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par) lst)
            par (1+ par)
      )
    )
    (setq llpt (apply 'mapcar (cons 'min lst))
          urpt (apply 'mapcar (cons 'max lst))
          vtx  (list llpt urpt)
    )
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts '(lambda (a b)(< (car (car a))(car (car b))))))
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (entmakelwpline (reverse lw-lst))
    )
  )
  (princ)
)

Hope that helps

Henrique

marko_ribar · ‎09-30-2014

Yes, it's untested...

Change this to :

(entmakelwpline (reverse lw-lst))

(make_lw (reverse lw-lst))

Marko Ribar, d.i.a. (graduated engineer of architecture)

hmsilva · ‎09-30-2014

marko_ribar wrote:

Change this to :
(entmakelwpline (reverse lw-lst))
(make_lw (reverse lw-lst))

Good catch!

Henrique

marlance · ‎09-30-2014

thanks

marlance · ‎09-30-2014

thanks it works

marlance · ‎09-30-2014

Hi henrique,

Can you modify it as show below?

marlance · ‎09-30-2014

Hi henrique,

This is a lisp written by my friend that will create multiple layout and viewport with the same scale.

That's the purpose of the lisp that I requested to you.

So what I want now is to combine these to code.

Thanks in advance

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;								;;;;;
;;;;;              FOR GENERAL LAYOUT				;;;;;
;;;;;								;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;==rename layout & set layout name to "1"==;;

(defun rlayout ()
(setvar "cmdecho" 0)
(setvar "tilemode" 0)
(setq lay_list (layoutlist))
(setq lay_no (length lay_list))
(setq lay_count 1)

(if (> lay_no 1)
(progn
(repeat (- lay_no 1)
(setq name (nth lay_count lay_list))
(command "-layout" "d" name)
(setq lay_count (+ lay_count 1))
);;end of repeat
(command "-layout" "r" "" "1")
);;end of progn
(progn
(command "-layout" "r" "" "1")
);;enf of progn
);;end of if
(setvar "cmdecho" 1)
(setvar "tilemode" 1)
);;end of function


;;==create guide pline==;;

(defun gpline ()
(setq pvert (car (entsel "\nSelect Polyline guide:")))
(setq plist (entget pvert))
(setq verlist (list))(foreach a plist (if (= 10 (car a)) (setq verlist (append verlist (list (cdr a))))))
(setq vert_no (length verlist))
)

;;==create layout==;;

(defun crlayout ()
(setvar "cmdecho" 0)
(setvar "tilemode" 0)
(setq old_tab (getvar "ctab"))
(setq no_lay (- (/ vert_no 2) 1))
(setq lay_ct 1)
(repeat no_lay
(setq no_1 (itoa (+ lay_ct 1)))
(setvar "LAYOUTCREATEVIEWPORT" 0)
(command "-layout" "n" no_1)
(setq lay_ct (atoi no_1))
)
(command "-layout" "s" old_tab)
(setvar "cmdecho" 1)
)

;;==create mview for every layout==;;


(defun mvs ()
(setvar "auprec" 8)
(setq tab_no (length (layoutlist)))
(setvar "osmode" 0)
(setq ps1 (getpoint))
(setq ps2 (getpoint))
(setvar "osmode" 0)
(setq ang_teta (angle ps1 ps2))
(setq cur_tab (getvar "ctab"))

(repeat tab_no
(command "_.MVIEW" ps1 ps2)
(setq vport (entlast))
(setq vportlist (entget vport))
(setq vport_id (cdr (assoc 69 vportlist)))
(command "zoom" "e")
(command "_.mspace")
(setvar "cvport" vport_id)
(setvar "ucsfollow" 1)
(setq ms2 (- (* (atoi cur_tab) 2) 1))
(setq ms1 (- ms2 1))
(setq mspt_01 (nth ms1 verlist))
(setq mspt_02 (nth ms2 verlist))
(setq ucs_ang (angtos (- (angle mspt_01 mspt_02) ang_teta)))
(command "ucs" "m" mspt_01)
(command "ucs" "z" ucs_ang)
(setvar "ucsfollow" 0)
(command "ucs" "w")
(command "zoom" mspt_01 mspt_02)
(command "_.pspace")
(command "_.mview" "l" "on" vport "")

(setq next_tab (+ (atoi (getvar "ctab")) 1))
(setq cur_tab (itoa next_tab))
(command "-layout" "set" cur_tab)
);;;end of repeat
(setvar "osmode" 15359)
);;;end of function

;;==create mview for every layout==;;

(defun c:cvp1 ()
(rlayout)
(gpline)
(crlayout)
(mvs)
(princ "\ncreated by:danesonmarcelino")
)

(defun c:demo ( / make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (defun make_lw (pt_lst)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par) lst)
            par (1+ par)
      )
    )
    (setq llpt (apply 'mapcar (cons 'min lst))
          urpt (apply 'mapcar (cons 'max lst))
          vtx  (list llpt urpt)
    )
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts '(lambda (a b)(< (car (car a))(car (car b))))))
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (make_lw (reverse lw-lst))
    )
  )
  (princ)
)

marlance · ‎09-30-2014

I had combined it already by still I'm not satisfied.

It would be great if someone will have to improve it.

regards

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;								;;;;;
;;;;;              FOR GENERAL LAYOUT				;;;;;
;;;;;								;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;==rename layout & set layout name to "1"==;;

(defun rlayout ()
(setvar "cmdecho" 0)
(setvar "tilemode" 0)
(setq lay_list (layoutlist))
(setq lay_no (length lay_list))
(setq lay_count 1)

(if (> lay_no 1)
(progn
(repeat (- lay_no 1)
(setq name (nth lay_count lay_list))
(command "-layout" "d" name)
(setq lay_count (+ lay_count 1))
);;end of repeat
(command "-layout" "r" "" "1")
);;end of progn
(progn
(command "-layout" "r" "" "1")
);;enf of progn
);;end of if
(setvar "cmdecho" 1)
(setvar "tilemode" 1)
);;end of function


;;;;;;;;;;;;;;;;;create polyline;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun poly ( / make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (defun make_lw (pt_lst)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par) lst)
            par (1+ par)
      )
    )
    (setq llpt (apply 'mapcar (cons 'min lst))
          urpt (apply 'mapcar (cons 'max lst))
          vtx  (list llpt urpt)
    )
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts '(lambda (a b)(< (car (car a))(car (car b))))))
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (make_lw (reverse lw-lst))
    )
  )
(setq polyguide (entlast))
  (princ)
)


;;==create guide pline==;;

(defun gpline ()
(setq pvert polyguide)
(setq plist (entget pvert))
(setq verlist (list))(foreach a plist (if (= 10 (car a)) (setq verlist (append verlist (list (cdr a))))))
(setq vert_no (length verlist))
)

;;==create layout==;;

(defun crlayout ()
(setvar "cmdecho" 0)
(setvar "tilemode" 0)
(setq old_tab (getvar "ctab"))
(setq no_lay (- (/ vert_no 2) 1))
(setq lay_ct 1)
(repeat no_lay
(setq no_1 (itoa (+ lay_ct 1)))
(setvar "LAYOUTCREATEVIEWPORT" 0)
(command "-layout" "n" no_1)
(setq lay_ct (atoi no_1))
)
(command "-layout" "s" old_tab)
(setvar "cmdecho" 1)
)

;;==create mview for every layout==;;


(defun mvs ()
(setvar "auprec" 8)
(setq tab_no (length (layoutlist)))
(setvar "osmode" 0)
(setq ps1 (getpoint))
(setq ps2 (getpoint))
(setvar "osmode" 0)
(setq ang_teta (angle ps1 ps2))
(setq cur_tab (getvar "ctab"))

(repeat tab_no
(command "_.MVIEW" ps1 ps2)
(setq vport (entlast))
(setq vportlist (entget vport))
(setq vport_id (cdr (assoc 69 vportlist)))
(command "zoom" "e")
(command "_.mspace")
(setvar "cvport" vport_id)
(setvar "ucsfollow" 1)
(setq ms2 (- (* (atoi cur_tab) 2) 1))
(setq ms1 (- ms2 1))
(setq mspt_01 (nth ms1 verlist))
(setq mspt_02 (nth ms2 verlist))
(setq ucs_ang (angtos (- (angle mspt_01 mspt_02) ang_teta)))
(command "ucs" "m" mspt_01)
(command "ucs" "z" ucs_ang)
(setvar "ucsfollow" 0)
(command "ucs" "w")
(command "zoom" mspt_01 mspt_02)
(command "_.pspace")
(command "_.mview" "l" "on" vport "")

(setq next_tab (+ (atoi (getvar "ctab")) 1))
(setq cur_tab (itoa next_tab))
(command "-layout" "set" cur_tab)
);;;end of repeat
(setvar "osmode" 15359)
);;;end of function

;;==create mview for every layout==;;

(defun c:cvp1 ()
(poly)
(rlayout)
(gpline)
(crlayout)
(mvs)
(princ "\ncreated by:danesonmarcelino")
)

hmsilva · ‎10-01-2014

@rulep21 wrote:

thanks it works

You're welcome, rulep21.

I'm out of office and without AutoCAD, so I can't give much help...
Let's hope someone else can step in and give you some help...

Henrique

marko_ribar · ‎10-01-2014

Here is Henrique's code revised for proposed picture...

The code did get kudo, so I give up of giving one...

Hope that now with this revision, you'll be able to compose your code satisfactory... Consider localizing your variables where that's possible - seeing that you are passing ename of created lwpolyline to other sub...

Revision :

(defun c:demo ( / make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (vl-load-com)

  (defun make_lw (pt_lst)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par) lst)
            par (1+ par)
      )
    )
    (setq llpt (apply 'mapcar (cons 'min lst))
          urpt (apply 'mapcar (cons 'max lst))
    )
    (setq llpt (vlax-curve-getclosestpointtoprojection ent llpt '(1.0 0.0 0.0))
          urpt (vlax-curve-getclosestpointtoprojection ent urpt '(1.0 0.0 0.0))
    )
    (setq vtx  (list llpt urpt))
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts '(lambda (a b)(< (car (car a))(car (car b))))))
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (make_lw (reverse lw-lst))
    )
  )
  (princ)
)

Marko R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

hmsilva · ‎10-01-2014

Quick and dirty fix...

Untested...

(defun c:demo ( / make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (defun make_lw (pt_lst / x)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par srt-lst urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par) lst)
            par (1+ par)
      )
    )
  (setq srt-lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
  (if (> (cadr (car srt-lst)) (cadr (cadr srt-lst)))
    (setq llpt (cadr srt-lst))
    (setq llpt (car srt-lst)))
  (if (> (cadr (caddr srt-lst)) (cadr (last srt-lst)))  
    (setq urpt (caddr srt-lst))
    (setq urpt (last srt-lst)))
    (setq vtx  (list llpt urpt)
    )
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts '(lambda (a b)(< (car (car a))(car (car b))))))
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (make_lw (reverse lw-lst))
    )
  )
  (princ)
)

HTH

Henrique

marko_ribar · ‎10-01-2014

I've just realized that it's cumbersome to play with "min" and "max" functions and that the point to this part of complete project is actually to follow path of vertices rectangles were created... So I deleted previous revision as it's unnecessary and wrong... I also think that your revision Henrique is also wrong... What if rectangles vertices are positioned the way the orientation of viewport is to be created and view inside of it in model space is rotated according to that rectangle, then your code will obtain uncorrect array of path vertices and therefore orientation of view may be wrong...

So all in all this simple code is what OP wants, me thinks...

(defun c:demo (/ make_lw get_vtx ent i lst-pts lw-lst pts-lst ss)

  (vl-load-com)

  (defun make_lw (pt_lst)
    (entmake
      (append
        (list
          '(0 . "LWPOLYLINE")
          '(100 . "AcDbEntity")
          '(100 . "AcDbPolyline")
          (cons 90 (length pt_lst))
        )
        (mapcar '(lambda (x) (cons 10 x)) pt_lst)
      )
    )
  )

  (defun get_vtx (ent / llpt lst obj par urpt vtx)
    (setq par 0
          obj (vlax-ename->vla-object ent)
    )
    (while (< par (vlax-curve-getEndParam obj))
      (setq lst (cons (vlax-curve-getPointAtParam obj par)
                      lst
                )
            par (1+ par)
      )
    )
    (setq lst (reverse lst))
    (setq llpt (car lst)
          urpt (caddr lst)
    )
    (setq vtx (list llpt urpt))
    vtx
  )

  (if (setq ss (ssget '((0 . "lwpolyline") (-4 . "&=") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
        (setq ent     (ssname ss (setq i (1- i)))
              lst-pts (cons (get_vtx ent) lst-pts)
        )
      )
      (setq pts-lst (vl-sort lst-pts
                             '(lambda (a b)
                                (< (car (car a))
                                   (car (car b))
                                )
                              )
                    )
      )
      (foreach pt pts-lst
        (setq lw-lst (cons (car pt) lw-lst)
              lw-lst (cons (cadr pt) lw-lst)
        )
      )
      (make_lw (reverse lw-lst))
    )
  )
  (princ)
)

HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)

hmsilva · ‎10-01-2014

@marko_ribar wrote:

I've just realized that it's cumbersome to play with "min" and "max" functions and that the point to this part of complete project is actually to follow path of vertices rectangles were created... So I deleted previous revision as it's unnecessary and wrong... I also think that your revision Henrique is also wrong... What if rectangles vertices are positioned the way the orientation of viewport is to be created and view inside of it in model space is rotated according to that rectangle, then your code will obtain uncorrect array of path vertices and therefore orientation of view may be wrong...

Marko,

I can't test the codes, but just for testing, try the codes with two rectangles, one drawn from the lower left to the upper right corner, and a second one drawn from the upper right corner to the lower left corner...

Henrique

marko_ribar · ‎10-01-2014

@hmsilva wrote:

Marko,
I can't test rhe codes, but just for testing try the codes with two rectangles, one drawn from the lower left to the upper right corner, and a second one drawn from the upper right corner to the lower left corner...

Henrique

So what Henrique, me thinks that routine should do just what I thought, obtaining path from 1st and 3rd vertex of rectangles... It's up to OP to create correct orientation of rectangles... First (ll-ur rectangle) is for normal view and second (ur-ll rectangle) is for rotated view from normal for 180 degree...

Marko Ribar, d.i.a. (graduated engineer of architecture)

hmsilva · ‎10-01-2014

@marko_ribar wrote:

So what Henrique, me thinks that routine should do just what I thought, obtaining path from 1st and 3rd vertex of rectangles... It's up to OP to create correct orientation of rectangles... First (ll-ur rectangle) is for normal view and second (ur-ll rectangle) is for rotated view from normal for 180 degree...

That was what I was saying, all rectangles must must be drawn from the lower left to the upper right corner.

Henrique

continous polyline from bottom left and top right of rectangle

continous polyline from bottom left and top right of rectangle

Forums Links

Post to forums