https://www.cadtutor.net/forum/topic/20 ... /#comments
The site Admin have said the code can be copied and used as required.
I am trying to create a 3D piping End Cap, very similar to the Dished Heads, using the modified code below.
The code works, but it puts the cap on the WCS plane NOT at the selected Insertion Point.
The goal is the user selects the insertion point of the end cap and the direction of the closed end of the pipework and the cap is drawn.
Code: Select all
(defun DRAW_END_CAP (/ BA# BF# BF1# BF2# BF3# CUS DCL_ID DUNT$ FLG# HTHK$ HTHK# HOD$ HOD# HID# HOD_LST ;
HTHK_LST IDR# IKR# INPT IANG LNAM$ LOOP$ SFLG$ SFLG# SFLG_LST THKL$ VRT# bf4# bf5# bf6#)
;
(setq DH:HOD$ (rtos N6)) ;default OD dia, take from DIM file
(setq DH:HTHK$ (rtos N9)) ;default wall thickness, take from DIM file
(setq DH:SFLG$ (rtos N3)) ;default Straight Flange (required), take from DIM file
(setq INPT (getpoint "\nSpecify Insertion point of End Cap: "))
(setq IANG (getpoint INPT "\nDrag cursor to select head orientation angle.")
INPT (trans INPT 1 0)
IANG (trans IANG 1 0)
)
(DH_SSP)
) ;end DRAW_END_CAP
;
; Set Size Parameters Function.
;
(defun DH_SSP ()
(setq HOD$ DH:HOD$ ;HOD$ is the main OD.
HTHK$ DH:HTHK$ ;HTHK# is the wall thickness.
SFLG$ DH:SFLG$ ;SFLG$ is the flange straight length.
HOD# (distof HOD$ 2) ;distof converts string to real value, with 2 = decimal
HTHK# (distof HTHK$ 2)
SFLG# (distof SFLG$ 2)
HID# (- HOD# (* HTHK# 2))
THKL$ DH:THKL$)
;
(setq IDR# (* HID# 0.9045) ;Head Rad ; change these if require to get profile shape (* HID# 0.9045)
IKR# (* HID# 0.1727) ;Knuckle Rad ; change these if require to get profile shape (* HID# 0.1727)
)
(DH_CDH)
)
;
; - Calculate Dished Head Function.
;
(defun DH_CDH (/ A1# A2# BA# CP01 CP02 CP03 DEG# PT01 PT02 PT03 PT04 PT05 PT06 PT07 PT08 PT09
RAD# RAD#A Sa# Sa2# Sb# Sc# TP01 TP02 TP03 TP04)
;
(setq RAD# (angle INPT IANG)
DEG# (DH_RTD RAD#))
;
(setq Sb# (- (/ HID# 2.0) IKR#)
Sc# (- IDR# IKR#)
Sa2# (- (* Sc# Sc#)(* Sb# Sb#))
Sa# (sqrt Sa2#)
RAD#A (/ Sb# Sc#)
A1# (DH_RTD RAD#A)
A2# (- 360 A1#)
);end setq
;
(setq BA# (list -64.3743 -52.7755)) ;part of LWPolyline bulge calculation
;
(setq PT01 (polar INPT (DH_DTR (+ DEG# 90))(/ HID# 2)) ;from insertion point.
PT03 (polar PT01 (DH_DTR (+ DEG# 0)) SFLG#)
PT02 (polar INPT (DH_DTR (+ DEG# 270))(/ HID# 2)) ;from insertion point.
PT04 (polar PT02 (DH_DTR (+ DEG# 0)) SFLG#)
PT05 (polar PT01 (DH_DTR (+ DEG# 90)) HTHK#)
PT07 (polar PT05 (DH_DTR (+ DEG# 0)) SFLG#)
PT06 (polar PT02 (DH_DTR (+ DEG# 270)) HTHK#)
PT08 (polar PT06 (DH_DTR (+ DEG# 0)) SFLG#)
PT09 (polar INPT (DH_DTR (+ DEG# 0)) SFLG#)
CP01 (polar PT03 (DH_DTR (+ DEG# 270)) IKR#)
CP02 (polar PT09 (DH_DTR (+ DEG# 180)) Sa#)
CP03 (polar PT04 (DH_DTR (+ DEG# 90)) IKR#)
TP01 (polar CP01 (DH_DTR (+ DEG# A1#)) IKR#)
TP03 (polar CP01 (DH_DTR (+ DEG# A1#))(+ IKR# HTHK#))
TP02 (polar CP03 (DH_DTR (+ DEG# A2#)) IKR#)
TP04 (polar CP03 (DH_DTR (+ DEG# A2#))(+ IKR# HTHK#))
BF1# (DH_ETC (/ (DH_DTR (nth 0 BA#)) 4)) ;bulge factor for curved lwpolylines
BF2# (DH_ETC (/ (DH_DTR (nth 1 BA#)) 4)) ;bulge factor for curved lwpolylines
BF3# (DH_ETC (/ (DH_DTR (nth 0 BA#)) 4)) ;bulge factor for curved lwpolylines
bf4# (* bf1# -1)
bf5# (* bf2# -1)
bf6# (* bf3# -1)
)
(DH_OLL) ; outside arc Point/Bulge list
)
;
; - Outline List Function.
;
(defun DH_OLL ()
(setq VRT# (list PT01 PT05 PT07 TP03 TP04 PT08 PT06 PT02 pt04 tp02 tp01 pt03)
BF# (list 0.0 0.0 BF1# BF2# BF3# 0.0 0.0 0.0 bf6# bf5# bf4# 0.0) FLG# 1)
(DH_DDH)
)
;
; - Draw Dished Head Function.
;
(defun DH_DDH ()
(entmakex
(list
(cons 0 "LWPOLYLINE") ;defines draw a LWPOLYLINE remember ""'s
(cons 100 "AcDbEntity") ;defines draw an entity
;-----------(cons 8 LNAM) ;defines the layer specifics, if ommited uses default (is that current?)
(cons 100 "AcDbPolyline") ;defines draw a LWPOLYLINE
(cons 90 (length VRT#))
(cons 70 1)
(cons 10 PT01) ;(cons 10 PNT number)
(cons 42 0.0) ;(cons 42 BF number)
(cons 10 PT05)
(cons 42 0.0)
(cons 10 PT07)
(cons 42 BF1#)
(cons 10 TP03)
(cons 42 BF2#)
(cons 10 TP04)
(cons 42 BF3#)
(cons 10 PT08)
(cons 42 0.0)
(cons 10 PT06)
(cons 42 0.0)
(cons 10 PT02)
(cons 42 0.0)
(cons 10 PT04)
(cons 42 BF6#)
(cons 10 TP02)
(cons 42 BF5#)
(cons 10 TP01)
(cons 42 BF4#)
(cons 10 PT03)
(cons 42 0.0)
)
)
;--------------------------------------------------------------------
; - draw 3D end Cap
(progn
(command "ucs" "ZA" INPT IANG)
(setq ENT1 (entlast))
(command "revolve" ENT1 "" "0,0,0" "0,0,100" "180")
(command "ucs" "_P")
)
)
;
; degree To Radians
;
(defun DH_DTR (a)(* pi (/ a 180.0)))
;
; Radian To Degrees
;
(defun DH_RTD (RAD#)(* 180.0 (/ RAD# pi)))
;
; Elbow Tangent Calculation Function.
;
(defun DH_ETC (a) (/ (sin a) (cos a)))
;
Thanks
Steve