[编程申请]：求助：相贯线放样

姜力明

我单位最近经常拿到管道结构工程，每天都要进行多次相贯线放样，线太多，看的头都晕了，求助哪位大师设计一个自动管道相贯线放样程序

zxq0220

这是一个画管子相贯线的程序。
XGX是画异径三通的相贯线。小管直径必须小于等于大管直径。
XGX2是画小管的下料展开图，不过在管子倾斜角小于90度时有问题。
程序支持AutoCAD R14版。

(DEFUN C:XGX ()
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETVAR "CMDECHO" 0)
(SETQ D (GETDIST "\nDiamter of D= ")
      DS (GETDIST "\nDiamter of d= "))
(WHILE (> DS D)
(PROMPT "\nThe d must less than D! ")
(SETQ DS (GETDIST "\nReinter Diamter of d= "))
)
(SETQ B (GETREAL "\nAngle of the pipe (DEG) B= <90> "))
(WHILE (= B 0)
(PROMPT "\nThe angle B must begger than 0")
(SETQ B (GETREAL "\nAngle of the pipe (DEG) B= <90> "))
)
(SETQ B (/ (* (IF (= B nil) 90 0) PI) 180)
      ANG (- B PI)
      A 0 TA (/ (* 5 PI) 180)
      RS (* DS 0.5) R (* D 0.5)
      PT (GETPOINT "\nPipe Conect Point : ")
      PT1 (POLAR PT 0 (/ RS (SIN B))))
(IF (EQUAL D DS 1E-5) (PROGN
(SETQ PT2 (POLAR PT ANG (/ RS (SIN B))) PT3 (POLAR PT PI (/ RS (SIN B))))
(COMMAND "PLINE" PT1 PT2 PT3 "")
) (PROGN
(SETQ A (+ A TA) RA (* (SIN A) RS) RB (* (COS A) RS))
(COMMAND "PLINE" PT1 "A")
(SETQ PT2 (POLAR (POLAR PT 0 (/ RB (SIN B))) ANG (/ (- R (SQRT (- (* R R) (* RA RA)))) (SIN B))))
(COMMAND "S" PT2)
(REPEAT 35
  (SETQ A (+ A TA) RA (* (SIN A) RS) RB (/ (* (COS A) RS) (SIN B))
        PT2 (POLAR (POLAR PT 0 RB) ANG (/ (- R (SQRT (- (* R R) (* RA RA)))) (SIN B))))
  (COMMAND PT2)
)
(COMMAND "")
))
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)

(DEFUN C:XGX2 ()
(SETQ OLDOS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETVAR "CMDECHO" 0)
(SETQ D (GETDIST "\n大管直径 Diamter of D= ")
      DS (GETDIST "\n小管直径 Diamter of d= "))
(WHILE (> DS D)
(PROMPT "\nThe d must less than D! 小管直径必须小于大管直径!")
(SETQ DS (GETDIST "\nReinter Diamter of 重新输入小管直径 d= "))
)
(SETQ B (GETREAL "\nAngle of the pipe 管子倾斜角 (DEG) B= <90> "))
(WHILE (= B 0)
(PROMPT "\nThe angle B must begger than 0! 倾斜角必须大于零!")
(SETQ B (GETREAL "\nAngle of the pipe (DEG) 重新输入倾斜角 B= <90> "))
)
(PROMPT "\nEnter Length of small pipe 小管长度 L= <")
(PRINC (* 3 DS))
(SETQ L (GETDIST "> "))
(SETQ L (IF (= L nil) (* 3 DS) L))
(SETQ B (/ (* (IF (= B nil) 90 B) PI) 180)
      ANG (- B PI) AL1 (/ PI 2) AL2 (- AL1)
      A 0 TA (/ (* 5 PI) 180)
      RS (* DS 0.5) R (* D 0.5)
      LSTEP (* TA RS)
      PT (GETPOINT "\nInsert Point : ")
      PT1 (POLAR PT PI (* RS PI))
      PT2 (POLAR PT1 AL1 L))
(SETQ A (+ A TA) RA (* (SIN A) RS))
(COMMAND "PLINE" PT2 "A")
(SETQ PT3 (POLAR PT2 0 LSTEP)
       PT2 (POLAR PT3 AL1 (/ (- R (SQRT (- (* R R) (* RA RA)))) (SIN B))))
(COMMAND "S" PT2)
(REPEAT 71
  (SETQ A (+ A TA) RA (* (SIN A) RS))
        PT3 (POLAR PT3 0 LSTEP)
        PT2 (POLAR PT3 AL1 (/ (- R (SQRT (- (* R R) (* RA RA)))) (SIN B))))
  (COMMAND PT2)
)
(SETQ PT3 (POLAR PT3 AL2 L))
(COMMAND "L" PT3 PT1 "C")
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(PRINC)
)