Catenary chain

[CALCAD]

Here's a just-for-fun program inspired, in part, by a Jeffery P. Sanders program 'chain.lsp' that draws straight sections of chain links. Using his open and edgelink blocks, my program draws hanging chain with the proper catenary curve. In my mechanical work, I would likely never have a real use for this but I'm hoping someone else may. They are welcome to it.

 

CHAIN2.dwg

CHAIN1.dwg

 

And an example

chain_example_2_BC.dwg

 

; cchain.lsp - Catenary Chain : Draws hanging chain with proper catenary curve in 2D,
;              using open and edge inserts originally from Jeffery P. Sanders.
;              Pick two level points to hang from. Specify number of links. Specify
;              a sag factor : reasonable input is about 0.1 to several hundred. 0.1
;              is a barely perceptible sag. 400 is very deep, almost no curve left.
;              Above a sag of 8 or 9, the non-circular curve becomes noticeable.
;              Note that any specified even number of links will be increased by
;              one, as only an odd number of links can be processed. The minimum
;              number that can be specified is two (which will be changed to three). 
;              Chain is hung between level points. To hang chain between uneven
;              points, draw a chain between level points then clip and scale to fit.

; Call with CC

; 12-24-10 Seems-to-be-working version for Icad 4 STD.
; 12-27-10 Removed some superfluous code. Seems to be working for Bricscad V11 for Linux.

; NOTE ::: Program requires chain1.dwg and chain2.dwg . I keep them in my lisp directory
;          so I don't have to hard code a path. If you can't stand that idea, you'll have
;          to add the path in the INSERT commands near the end of the program or maybe
;          your support path will find them. 


; hyperbolic cosine

(defun cosh (x)
 (/ (+ (exp x) (exp (* -1.0 x))) 2.0)
)

; convert hex to dec

(defun htd (hexin / hlen hc hlist n decttl h dec)
(setq hlen (strlen hexin))
(repeat hlen
(setq hc (substr hexin 1 1))
(setq hc (strcase hc))
(setq hlist (cons hc hlist))
(setq hexin (substr hexin 2))
)
(setq n 1)
(setq decttl 0)
(foreach h hlist
(cond ((= h "0")(setq dec (* 0 n)))
   ((= h "1")(setq dec (* 1 n)))
   ((= h "2")(setq dec (* 2 n)))
   ((= h "3")(setq dec (* 3 n)))
   ((= h "4")(setq dec (* 4 n)))
   ((= h "5")(setq dec (* 5 n)))
   ((= h "6")(setq dec (* 6 n)))
   ((= h "7")(setq dec (* 7 n)))
   ((= h "8")(setq dec (* 8 n)))
   ((= h "9")(setq dec (* 9 n)))
   ((= h "A")(setq dec (* 10 n)))
   ((= h "B")(setq dec (* 11 n)))
   ((= h "C")(setq dec (* 12 n)))
   ((= h "D")(setq dec (* 13 n)))
   ((= h "E")(setq dec (* 14 n)))
   ((= h "F")(setq dec (* 15 n)))
   (T nil)
)
(setq n (* n 16))
(setq decttl (+ decttl dec))
) 
)


(defun c:cc (/ *ERROR* osave numlink x n plst polyen hbase aent lenset lenlist ns enam htry dh_1 dpt dinc
              cesys spanscale dspan hloc areflist1 areflist2 fdang angleft angright alist1 alist2
              chst chend usf p_1 p_2 span spaninc chstx chsty tmpx yoff fn chendx xoffset yoffset
              even ns na ht wd inloc inang olinkset elinkset)

(defun *ERROR* (msg)
(setvar "OSMODE" osave)
(setvar "cmdecho" cesys)
(princ)
)

(setq osave (getvar "OSMODE"))
(setq cesys (getvar "CMDECHO"))
(setvar "cmdecho" 0)
(setq chst (getpoint "\n Select point to start chain "))
(setq chend (getpoint "\n Select other end "))
(setq chstx (car chst))
(setq chendx (car chend))
(if (> chstx chendx) ; swap points to allow any pick order
(progn
 (setq tmpx chstx)
 (setq chstx chendx)
 (setq chendx tmpx)
)
)
(setq chsty (cadr chst))
(setvar "OSMODE" 0)
(setq span (distance chst chend))
(princ "\n Span = ")(princ span)
(initget 7)
(setq numlink (getint "\n Number of links in chain : "))
(if (equal (rem numlink 2) 0)
(setq even T)
(setq even nil)
)
(if even
(setq numlink (+ numlink 1)) ; numlink must be odd
)
(setq spanscale (/ span 2))
(setq xoffset (- chstx -1.0))
(setq yoffset chsty)
(setq x -1.0)
(setq yoff (cosh x))
(setq usf (getreal " Enter sag factor : "))
(setq usf (/ usf 10.0))
(setq yoff (* yoff usf))

(setq spaninc (/ 2.0 (- numlink 1)))
(repeat numlink  
(setq plst (cons (list x (- (* (cosh x) usf) yoff) 0) plst))
(setq x (+ x spaninc))
)
(command "._polyline" plst "") ; draw polyline
(setq plst (reverse plst))
(command "._editpline" (entlast) "F" "X")   ; smooth arc
(setq p_1 (car plst)) ; get first and last position of the polyline
(setq p_2 (last plst))
(setq polyen (entlast))                         ; polyen is the entity name of the polyline
(setq hbase (cdr (assoc 5 (entget polyen))))    ; hbase is the handle of the polyline
(setq hbase (htd hbase))                        ; convert to decimal integer
(command "._divide" polyen (- numlink 1)) ; generate point set for link locations and angle reference
(setq aent (ssget "X"))
(setq lenset (sslength aent))
(setq ns 0)
(repeat lenset
(setq enam (ssname aent ns))
(setq htry (cdr (assoc 5 (entget enam))))
(setq htry (htd htry))                  ; convert to decimal integer
(if (> htry hbase)
 (progn
  (setq hloc (cons (cdr (assoc 10 (entget enam))) hloc)) ; hloc contains the link positions except end points
  (setq dh_1 (cons enam dh_1)) ; dh_1 is a list of the names of the division point set
 ) 
)
(setq ns (+ ns 1))
)
(setq hloc (cons p_1 hloc)) ; add the endpositions of the polyline to the division set
(setq hloc (append hloc (list p_2)))
(setq dinc (distance (cadr hloc) (caddr hloc)))
(setq angleft (angtos (angle (car hloc) (cadr hloc)) 0 1))
(setq angright (angtos (angle (car (reverse hloc)) (cadr (reverse hloc))) 0 1))
(setq lenset (length hloc))

; open link angles : areflist1 and alist1

(setq ns 1)
(while (< ns lenset) ; compile list of positions for angle reference
 (setq areflist1 (cons (nth ns hloc) areflist1))
 (setq ns (+ ns 2))  
)
(setq areflist1 (reverse areflist1)) ; reverse to correct cons order
(setq alist1 ())
(setq ns 1)
(setq lenset (length areflist1))
(while (< ns lenset)  ; compile alist1 : the list of angles between positions
(setq fdang (car areflist1))
(setq alist1 (cons (angtos (- (angle fdang (cadr areflist1))) 0 1) alist1))
(setq areflist1 (cdr areflist1))
(setq ns (+ ns 1))
)
(setq alist1 (cons angleft alist1))
(setq alist1 (append alist1 (list angright)))

; edge link angles : areflist2 and alist2

(setq lenset (length hloc))
(setq ns 0)
(while (< ns lenset) ; compile list of positions for angle reference
(setq areflist2 (cons (nth ns hloc) areflist2))
(setq ns (+ ns 2))  
)
(setq areflist2 (reverse areflist2)) ; reverse to correct cons order
(setq alist2 ())
(setq ns 0)
(setq lenset (length areflist2))
(while (< ns  (- lenset 1))  ; compile alist2 : the list of angles between positions
(setq fdang (car areflist2))
(setq alist2 (cons (angtos (- (angle fdang (cadr areflist2))) 0 1) alist2))
(setq areflist2 (cdr areflist2))
(setq ns (+ ns 1))
)
(setq ht (* dinc 1.15)) ; scale of link inserts - proportional to length of polyline
(setq wd (* dinc 1.15))
(setq ns 0)
(setq na 0)
(setq olinkset (ssadd))
(setq elinkset (ssadd))
(setq lenset (- (length hloc) 1))
(while (< ns (+ lenset 1))
 (setq inloc (nth ns hloc))
 (setq inang (nth na alist1))
 (command "._insert" "CHAIN1" (nth ns hloc) ht wd (nth na alist1))
 (setq olinkset (ssadd (entlast) olinkset))
 (setq ns (+ ns 2))
 (setq na (+ na 1))
)
(setq ns 1)
(setq na 0)
(while (< ns (+ lenset 1))
 (setq inloc (nth ns hloc))
 (setq inang (nth na alist2))
 (command "._insert" "CHAIN2" (nth ns hloc) ht wd (nth na alist2))
 (setq elinkset (ssadd (entlast) elinkset))
 (setq ns (+ ns 2))
 (setq na (+ na 1))
) 
; delete polyline and division points
(entdel polyen)
(foreach dpt dh_1
(entdel dpt)
)
(command "._scale" olinkset "" (list (car hloc)) spanscale)
(command "._scale" elinkset "" (list (car hloc)) spanscale)
(command "._move" olinkset "" (list 0 0 0) (list xoffset yoffset 0))
(command "._move" elinkset "" (list 0 0 0) (list xoffset yoffset 0))
(setvar "OSMODE" osave)
(setvar "cmdecho" cesys)
(princ)
)