;;; Draw pipe section with user defined diameter on user defined layer with Associative Centerlines
;;; Based on Lee Mac and Luca Romanini routines saved from: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-circle/m-p/6642280#U6642280
;;; Combined by Igal Averbuh 2016 (adapted to cm. units)

;;--------------=={ Associative Centerlines }==---------------;;
;; ;;
;; Uses reactors to update centerlines following ;;
;; modification of associated circles. Stores entity handles ;;
;; in entity xData to enable reactor rebuild upon loading, ;;
;; allowing retention of associativity between sessions. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ?2011 - http://www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Version 1.0 - 12-05-2011 ;;
;;------------------------------------------------------------;;

(setq cl:ratio 1.25 cl:app "LMAC_CL")

;;------------------------------------------------------------;;

(defun c:CL ( / _line ss e c r l1 l2 )
(vl-load-com)
(if (= (tblsearch "ltype" "center") nil)
(command "linetype" "l" "center" "acad.lin" "")
)
(if
(and
(setq ss
(ssget "L"
(list '(0 . "CIRCLE") '(-4 . ""))
)
)
(or (tblsearch "APPID" cl:app) (regapp cl:app))
)
(progn
(defun _line ( p1 p2 h )
(entmakex
(list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 6 "center")
(list -3
(list cl:app
(cons 1002 "{") (cons 1005 h) (cons 1002 "}")
)
)
)
)
)
(repeat (setq i (sslength ss))
(setq e (entget (ssname ss (setq i (1- i))))
h (cdr (assoc 5 e))
c (cdr (assoc 10 e))
r (* cl:ratio (cdr (assoc 40 e)))
l1 (_line (polar c 0. r) (polar c pi r) h)
l2 (_line (polar c (/ pi 2.) r) (polar c (/ (* 3. pi) 2.) r) h)
)
(entmod
(list (assoc -1 e)
(list -3
(list cl:app
(cons 1002 "{")
(cons 1005 (cdr (assoc 5 (entget l1))))
(cons 1005 (cdr (assoc 5 (entget l2))))
(cons 1002 "}")
)
)
)
)
(vlr-object-reactor (list (vlax-ename->vla-object (cdr (assoc -1 e)))) (list cl:app h)
(list
(cons :vlr-modified 'cl:circle:callback)
)
)
(vlr-object-reactor (mapcar 'vlax-ename->vla-object (list l1 l2)) (list cl:app h)
(list
(cons :vlr-modified 'cl:line:callback)
)
)
)
)
)
(princ)
)

;;------------------------------------------------------------;;

(defun c:clremove ( / _massoc ss fl i e r d h x )

(defun _massoc ( x l )
(if (setq a (assoc x l))
(cons (cdr a) (_massoc x (cdr (member a l))))
)
)

(princ "\nSelect Circles to Remove Associativity : ")
(setq fl (list '(0 . "CIRCLE") (list -3 (list cl:app))) i -1)

(if
(setq ss
(cond
( (ssget fl) )
( (ssget "_X" fl) )
)
)
(while (setq e (ssname ss (setq i (1+ i)))) (setq e (entget e (list cl:app)))
(foreach r (cdar (vlr-reactors :vlr-object-reactor))
(if
(and
(setq d (vlr-data r))
(listp d)
(eq cl:app (car d))
(or (not (cadr d)) (eq (cdr (assoc 5 e)) (cadr d)))
)
(vlr-remove r)
)
)
(foreach h (_massoc 1005 (cdadr (assoc -3 e)))
(if (setq x (entget (handent h)))
(entmod (list (assoc -1 x) (list -3 (list cl:app))))
)
)
(entmod (list (assoc -1 e) (list -3 (list cl:app))))
)
)
(princ)
)

;;------------------------------------------------------------;;

(defun cl:circle:callback ( owner reactor params / xtyp xval c r )
(if
(and
(vlax-read-enabled-p owner)
(progn (vla-getxdata owner cl:app 'xtyp 'xval) xval)
(setq
c (vlax-get owner 'center)
r (* cl:ratio (vlax-get owner 'radius))
)
)
(mapcar
(function
(lambda ( h a )
(if (or (entget (setq h (handent h))) (entdel h))
(entmod
(list (cons -1 h) (cons 10 (polar c a r)) (cons 11 (polar c (+ a pi) r)))
)
)
)
)
(cddr (mapcar 'vlax-variant-value (vlax-safearray->list xval))) (list 0. (/ pi 2.))
)
)
(princ)
)

;;------------------------------------------------------------;;

(defun cl:line:callback ( owner reactor params )
(setq *data (list owner reactor))
(vlr-command-reactor (list cl:app)
(list
(cons :vlr-commandended 'cl:line:modify)
(cons :vlr-commandcancelled 'cl:line:cancelled)
(cons :vlr-commandfailed 'cl:line:cancelled)
)
)
(vlr-remove reactor)
(princ)
)

;;------------------------------------------------------------;;

(defun cl:line:modify ( reactor params / xtyp xval h ) (vlr-remove reactor)
(if
(and *data (not (vlax-erased-p (car *data))) (progn (vla-getxdata (car *data) cl:app 'xtyp 'xval) xval)
(or
(entget
(setq h
(handent
(caddr
(mapcar 'vlax-variant-value (vlax-safearray->list xval))
)
)
)
)
(entdel h)
)
)
(progn
(cl:circle:callback (vlax-ename->vla-object h) nil nil)
(vlr-add (cadr *data))
(setq *data nil)
)
)
(princ)
)

;;------------------------------------------------------------;;

(defun cl:line:cancelled ( reactor params ) (vlr-remove reactor)
(if *data
(progn
(vlr-add (cadr *data))
(setq *data nil)
)
)
(princ)
)

;;------------------------------------------------------------;;

(
(lambda ( / r d s i e o xtyp xval )
(foreach r (cdar (vlr-reactors :vlr-object-reactor))
(if (and (setq d (vlr-data r)) (listp d) (eq cl:app (car d)))
(vlr-remove r)
)
)
(if (setq s (ssget "_X" (list '(0 . "CIRCLE") (list -3 (list cl:app)))))
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i))))
(vlr-object-reactor (list (setq o (vlax-ename->vla-object e))) (list cl:app (cdr (assoc 5 (entget e))))
(list
(cons :vlr-modified 'cl:circle:callback)
)
)
(vla-getxdata o cl:app 'xtyp 'xval) (setq xval (mapcar 'vlax-variant-value (vlax-safearray->list xval)))
(vlr-object-reactor
(mapcar
(function
(lambda ( h )
(or (entget (setq h (handent h))) (entdel h)) (vlax-ename->vla-object h)
)
)
(list (caddr xval) (cadddr xval))
)
(list cl:app (cdr (assoc 5 (entget e)))) (list (cons :vlr-modified 'cl:line:callback))
)
)
)
)
)

(vl-load-com) (princ)

;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;

(DEFUN c:dia ( / CNT DIAM INCH P1)

(setq P1 (entsel "\nSelect an object to create the circle in the same layer: "))
(setq CNT (getpoint "\nSelect circle center")) ;click the center of the circle

(initget 1 "2 2.5 3 3.5 4 6 8 10 12 14 16 18 20")

(setq INCH (getkword "\nSelect Diameter: [2 / 2.5 / 3 / 3.5 / 4 / 6 / 8 / 10 / 12 / 14 / 16 / 18 / 20]"))

(setq DIAM (cond ((= INCH "2") 6.0325)
((= INCH "2.5") 7.3025)
((= INCH "3") 8.89)
((= INCH "3.5") 10.16)
((= INCH "4") 11.43)
((= INCH "6") 16.83)
((= INCH "8") 21.91)
((= INCH "10") 27.30)
((= INCH "12") 32.38)
((= INCH "14") 35.56)
((= INCH "16") 40.64)
((= INCH "18") 45.72)
((= INCH "20") 50.80)
);End conditional
) ;End setq DIAM

(command "laymcur" P1) ; to move in other layer with a select
(command "circle" "_non" CNT "D" DIAM) ;draw the circle
(command "layerp") ; return in the original layer

(PRINC)
)

(defun c:dc()
(c:dia)
(c:cl)
(princ)
)
(c:dc)

Advertisements