Jump to content
dughug

Help modifying a modified divide lisp from Cadalyst website

Recommended Posts

dughug

Hi all:

 

I like using Lisps, but don't know how to write code for them. I like this particular lisp created by Mosad Elewa and posted on Cadalyst.com. When trying the lisp on a polyline, it did not work. Seems to only work on a "line". Here's the code:

 

----------------------------------------------------------------------------------------------------

 

;;;CADALYST 02/07 Tip 2180: DIV.LSP Modify Divide © 2007 Mosad Elewa


;DIV.LSP BY MOSAD H. ELEWA (1996)

(defun C:DIV ()

 

(setq ent (entget (car (entsel "\nSelect object to divide"))))

(setq etype (cdr (assoc 0 ent)))

(if (eq etype "LINE")

(progn

(cond

( (setq m (getint "\nNumber of segments"))

(setq pt1 (cdr (assoc 10 ent)))

(setq pt2 (cdr (assoc 11 ent)))

(setq ang (angle pt1 pt2))

(setq dist (distance pt1 pt2))

(setq dd (/ dist m))

(setq pt3 (polar pt1 ang dd))

(setq ang2 (+ ang 1.5708))

(setq pt4 (polar pt3 ang2 (/ dd 4)))

(setq ds (distance pt1 pt3))

(command "line" pt3 pt4 "")

(setq pt5 (polar pt3 ang2 (/ dd ))

(command "move" "l" "" pt4 pt5)

(setq d 0)

; (setvar "cmdecho" 0)

(command

"copy" "l" "" "m" pt1)

(repeat (- m 2)

(command

(polar pt1 ang (setq d (+ d ds)))))

(command "")))

))

(if (eq etype "ARC")

(progn

(setq n (getint "\Number of segments"))

(setq ang (cdr (assoc 50 ent)))

(setq ang2 (cdr (assoc 51 ent)))

(setq ang3 (- ang2 ang))

(setq ang4 (/ (* ang3 180.0) pi))

(setq cp (cdr (assoc 10 ent)))

(setq r (cdr (assoc 40 ent)))

(setq pt1 (polar cp ang r))

(setq pt2 (polar cp ang (/ r 4)))

(setq pt3 (polar cp ang (/ r ))

(command "line" cp pt2 "")

(command "move" "l" "" pt3 pt1)

(command "array" "l" "" "p" cp (+ n 1) ang4 "y")

))

(if (eq etype "CIRCLE")

(progn

(setq n (getint "\Number of segments"))

(setq cp (cdr (assoc 10 ent)))

(setq r (cdr (assoc 40 ent)))

(setq pt1 (polar cp 0 r))

(setq pt2 (polar cp 0 (/ r 4)))

(setq pt3 (polar cp 0 (/ r ))

(command "line" cp pt2 "")

(command "move" "l" "" pt3 pt1)

(command "array" "l" "" "p" cp n "360" "y")

))

(princ)

)[/CODE]

 

-----------------------------------------------------------------------------------------------------

Share this post


Link to post
Share on other sites
Tharwat

Try this code ....

 

(defun c:test (/ s n j sn d i l pt ang)
 (vl-load-com)
;;; Tharwat 02. Jan. 2013 ;;;
 (if (and (setq n (getint "\n Number of segments :"))
          (setq s (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ELLIPSE,SPLINE,ARC"))))
     )
   (if (not (eq n 0))
     (repeat (setq j (sslength s))
       (setq sn (ssname s (setq j (1- j))))
       (setq d (/ (vlax-curve-getdistatparam sn (vlax-curve-getendparam sn)) n)
             i d
             l (/ d 10.)
       )
       (repeat n
         (setq pt (vlax-curve-getpointatdist sn i))
         (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv sn (vlax-curve-getparamatpoint sn pt))))
         (entmakex (list '(0 . "LINE")
                         (cons 10 (polar pt (+ ang (/ pi 2.)) l))
                         (cons 11 (polar pt (- ang (/ pi 2.)) l))
                   )
         )
         (setq i (+ d i))
       )
     )
     (alert "Number of segments must be bigger than ZERO !!")
   )
 )
 (princ)
)

Edited by Tharwat

Share this post


Link to post
Share on other sites
Tharwat

read THIS for Code Posting Guidelines

Share this post


Link to post
Share on other sites
dughug
read THIS for Code Posting Guidelines

 

Thanks Tharwat. This lisp doesn't work for a heavy polyline (2D polyline). Can you write the code where it will work on any type of line?

Share this post


Link to post
Share on other sites
Tharwat
Thanks Tharwat. This lisp doesn't work for a heavy polyline (2D polyline). Can you write the code where it will work on any type of line?

 

Codes updated to work on many kinds of entities .

Share this post


Link to post
Share on other sites
Lee Mac

Why not use the built-in DIVIDE command?

Share this post


Link to post
Share on other sites
SLW210

dughug,

 

Please edit your post to include Code Tags.

Share this post


Link to post
Share on other sites
danglar

a little modification of Tharwat code can be helpful for light poles distribution according to rule: x/2 x x x/2

 

;;; Divide POLYLINEs,LINEs,CIRCLEs,ELLIPSEs,SPLINEs and ARCs according to light poles distribution purposes
;;; Modified by Igal Averbuh  2018 (added optilon  x/2 x x x/2 divide for lighting purposes)
;;; Created by ;;; Tharwat 02. Jan. 2013 ;;;
;;; Saved from: https://www.cadtutor.net/forum/topic/43505-help-modifying-a-modified-divide-lisp-from-cadalyst-website/

(defun c:AD (/ s n j sn d i l pt ang)
 (vl-load-com)

 (if (and (setq n (getint "\n Number of segments :"))
          (setq s (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ELLIPSE,SPLINE,ARC"))))
     )
   (if (not (eq n 0))
     (repeat (setq j (sslength s))
       (setq sn (ssname s (setq j (1- j))))
       (setq d (/ (vlax-curve-getdistatparam sn (vlax-curve-getendparam sn)) n)
             i (* d 0.5)
             l (/ d 10.)
       )
       (repeat n
         (setq pt (vlax-curve-getpointatdist sn i))
         (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv sn (vlax-curve-getparamatpoint sn pt))))
         (entmakex (list '(0 . "LINE")
                         (cons 10 (polar pt (+ ang (/ pi 2.)) l))
                         (cons 11 (polar pt (- ang (/ pi 2.)) l))
                   )
         )
         (setq i (+ d i))
       )
     )
     (alert "Number of segments must be bigger than ZERO !!")
   )
 )
 (princ)
)
(c:ad)

 

Share this post


Link to post
Share on other sites

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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...