Jump to content

Automatic layout LISP

Dani_Nadir

By Dani_Nadir
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Dani_Nadir Apprentice

Dani_Nadir

Posted
Posted

Hello,

 

I am interested in a LISP able to make overlapping sheets as layouts following a road alignment and overlap a fraction. Each sheet will have its own UCS or view orientation. You can see it from these videos:

 

 

 

anyone knows one?

 

Best regards,

Daniel

  • Like 2
  • Thanks 1
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted (edited)

I've done similar work. Drawing fiber optics lines along railway tracks. We also made these overlapping viewports. I'll see if I can help

 

 

-----

EDIT

 

Here is a start. It draws the center lines of the viewports.

 

(defun Line (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2))))

;; based on @see http://www.lee-mac.com/totallengthandarea.html
(defun totalLengthPolyline ( s / i)
     (setq l 0.0)
     (repeat (setq i (sslength s))
         (setq e (ssname s (setq i (1- i)))
               l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
         )
     )
  l
)

;;BASED ON @see https://forums.autodesk.com/t5/autocad-forum/lisp-for-placing-a-point-on-polyline/td-p/3782300
;; Par GC - 09/2009 - Version 1.10

(defun PointAtDist2 (dist ss  / result point cnt1 cnt2)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq cnt1 0
       cnt2 0
 )
 (if ss
   (progn
     (setq space (vla-get-ModelSpace *acdoc*))
     (vla-StartUndoMark *acdoc*)
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
       (setq cnt1 (1+ cnt1))
       (if (setq result (vlax-curve-getPointAtDist obj dist))
         (progn
           (setq point result)
           (setq cnt2 (1+ cnt2))
           (if point
             T ;; (vla-AddPoint space (vlax-3d-point result))
           )
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 result   ;; returns the point
)


(defun c:ov2 ( / ss my_dist dist oldpoint newpoint newpoint2 overlap )  ;; ss dist result point cnt1 cnt2
(setq my_dist (getreal "\nViewport length: "))
(setq overlap (getreal "\nOverlap length: "))
;;(setq my_dist 100)
;;(setq overlap 15)
   
 (setq dist my_dist)

 ;; User selects a polyline
(setq ss (ssget (list '(-4 . "<OR") '(0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE")
                           '(-4 . "<AND") '(0 . "POLYLINE") '(-4 . "<NOT") '(-4 . "&")
                           '(70 . 112) '(-4 . "NOT>") '(-4 . "AND>") '(-4 . "OR>"))
              )
 )
 (setq oldpoint (PointAtDist2 0 ss))
 (while 
   (and 
     (setq newpoint (PointAtDist2 dist ss))
     (setq newpoint2 (PointAtDist2 (+ dist overlap) ss))
   )
   (progn
     (setq dist (+ dist my_dist ))
     (princ newpoint)
     
     (Line oldpoint newpoint2)
     
     (setq oldpoint newpoint)
     ;;(getstring ".")
   )
 )
 ;; last point at the end
 (setq newpoint (PointAtDist2 (totalLengthPolyline ss) ss))
)

Edited by Emmanuel Delay
Dani_Nadir Apprentice

Dani_Nadir

Posted
  • Author
Posted

Hello,

I don't know what you mean.

Dani_Nadir Apprentice

Dani_Nadir

Posted
  • Author
Posted
I've done similar work. Drawing fiber optics lines along railway tracks. We also made these overlapping viewports. I'll see if I can help

 

 

-----

EDIT

 

Here is a start. It draws the center lines of the viewports.

 

(defun Line (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2))))

;; based on @see http://www.lee-mac.com/totallengthandarea.html
(defun totalLengthPolyline ( s / i)
     (setq l 0.0)
     (repeat (setq i (sslength s))
         (setq e (ssname s (setq i (1- i)))
               l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e)))
         )
     )
  l
)

;;BASED ON @see https://forums.autodesk.com/t5/autocad-forum/lisp-for-placing-a-point-on-polyline/td-p/3782300
;; Par GC - 09/2009 - Version 1.10

(defun PointAtDist2 (dist ss  / result point cnt1 cnt2)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq cnt1 0
       cnt2 0
 )
 (if ss
   (progn
     (setq space (vla-get-ModelSpace *acdoc*))
     (vla-StartUndoMark *acdoc*)
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
       (setq cnt1 (1+ cnt1))
       (if (setq result (vlax-curve-getPointAtDist obj dist))
         (progn
           (setq point result)
           (setq cnt2 (1+ cnt2))
           (if point
             T ;; (vla-AddPoint space (vlax-3d-point result))
           )
         )
       )
     )
     (vla-delete ss)
     (vla-EndUndoMark *acdoc*)
   )
 )
 result   ;; returns the point
)


(defun c:ov2 ( / ss my_dist dist oldpoint newpoint newpoint2 overlap )  ;; ss dist result point cnt1 cnt2
(setq my_dist (getreal "\nViewport length: "))
(setq overlap (getreal "\nOverlap length: "))
;;(setq my_dist 100)
;;(setq overlap 15)
   
 (setq dist my_dist)

 ;; User selects a polyline
(setq ss (ssget (list '(-4 . "<OR") '(0 . "ARC,CIRCLE,ELLIPSE,LINE,LWPOLYLINE,SPLINE")
                           '(-4 . "<AND") '(0 . "POLYLINE") '(-4 . "<NOT") '(-4 . "&")
                           '(70 . 112) '(-4 . "NOT>") '(-4 . "AND>") '(-4 . "OR>"))
              )
 )
 (setq oldpoint (PointAtDist2 0 ss))
 (while 
   (and 
     (setq newpoint (PointAtDist2 dist ss))
     (setq newpoint2 (PointAtDist2 (+ dist overlap) ss))
   )
   (progn
     (setq dist (+ dist my_dist ))
     (princ newpoint)
     
     (Line oldpoint newpoint2)
     
     (setq oldpoint newpoint)
     ;;(getstring ".")
   )
 )
 ;; last point at the end
 (setq newpoint (PointAtDist2 (totalLengthPolyline ss) ss))
)

 

 

Hello,

 

Thanks for replying. When I load the routine, autocad gives me an error: "error: no function definition: p1"

And I can't run the routine.

 

Best regards,

Daniel

  • 3 months later...
ramesh patel Newbie

ramesh patel

Posted
Posted

how to load this autoviewport application

  • 5 months later...
Nila Newbie

Nila

Posted
Posted

The following lsip has some error, anyone can rectify it

 

;-------------plan developer------------------

(defun c:pd1()

(setq sel (ssget "x" (list (cons 0 "INSERT") (cons 2 "plan-sheet")) ))

(setq len (sslength sel))
(setq n 0)

(while (< n len)

(setq ent1 (ssname sel n)) 

(setq b (entget ent1))
(setq centpt (assoc 10 b))
(setq centpt (cdr centpt))
(setq rot (assoc 50 b))
(setq rot (cdr rot))
(setq rot (/ rot 3.14286))
(setq rot (* rot 180))
(setq rot (- rot))
(setq sc (assoc 41 b))
(setq sc (cdr sc))
(setq sc (/ 1 sc))
(setq sc (rtos 2.80 2 2))
(setq sc (strcat sc "xp"))

(setq en2 (entnext ent1))
(setq en2 (entget en2))
(setq name (assoc 1 en2))
(setq name (cdr name))

(command "layout" "c" "temp" name)
(command "layout" "s" name)


(command "mspace")
(command "cvport" "2")
(command "zoom" "c" centpt sc)
(command "dview" "all" "" "tw" rot "")
(command "pspace")

(setq n (+ n 1))


)


)


;----------profile developer-----------------

(defun c:ppd()

;center of datum and data

(setq sel (ssget "X" (list (cons 0 "INSERT") (cons 2 "PROFILE-SHEET")) ))

(setq len (sslength sel))
(setq n 0)

(while (< n len)

(setq ent1 (ssname sel n)) 
(setq b (entget ent1))
(setq centpt (assoc 10 b))
(setq centpt (cdr centpt))
(setq centptx (car centpt))
(setq centpty (car (cdr centpt)))

;change the distance to base as required based on viewport

(setq xpos 1546.6625)
(setq ypos 4087.0464)


(setq centpt4 (list centptx ypos))

(setq centpt5 (list xpos ypos))

(setq centpt6 (list xpos centpty))

(setq rot (assoc 50 b))
(setq rot (cdr rot))

(setq rot (/ rot 3.14286))
(setq rot (* rot 180))
(setq rot (- rot))
(setq sc (assoc 41 b))
(setq sc (cdr sc))
(setq sc (/ 1 sc))
(setq sc (rtos sc 2 2))
(setq sc (strcat sc "xp"))


(setq en2 (entnext ent1))
(setq en2 (entget en2))
(setq name (assoc 1 en2))
(setq name (cdr name))

(command "layout" "s" name)

(command "mspace")
;main
(command "cvport" "3")
(command "zoom" "c" centpt sc)
;details
(command "cvport" "4")
(command "zoom" "c" centpt4 sc)

(command "cvport" "5")
(command "zoom" "c" centpt6 sc)

;(command "cvport" "5")
;(command "zoom" "c" centpt5 sc)
(command "pspace")


(setq n (+ n 1))

)

(command "tilemode" "1")
)

 

 

 

 

 

  • 2 months later...
Nila Newbie

Nila

Posted
Posted
On 30/06/2018 at 23:10, Dani_Nadir said:

 Hello Dani 

          Are you got solution for this problem.  i also need that solution, try to response.

 

On 28/06/2018 at 21:24, Dani_Nadir said:

Hello,

 

I am interested in a LISP able to make overlapping sheets as layouts following a road alignment and overlap a fraction. Each sheet will have its own UCS or view orientation. You can see it from these videos:

 

 

 

 

 

anyone knows one?

 

Best regards,

Daniel

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...