双线管道绘制，请各位多多指教。
第一个自己写的程序。双线管道绘制，请各位多多指教。本帖最后由 ZZXXQQ 于 2021-11-3 16:44 编辑
2004年的老程序了。没什么错。下面是修改过的：
;管线绘制 ZZXXQQ 2004.11.11
(DEFUN C:DRAWPIPE ()
(SETvar "CMDECHO" 0)
(SETQ OLDOS (GETvar "OSMODE"))
(SETvar "OSMODE" 0)
(SETQ D (GETDIST "\n输入管子外径 D= <20>")
D (IF (NOT D) 20 D)
D5 (* D 0.5)
R (GETREAL (STRCAT "\n输入管子弯曲半径 <大于" (RTOS D5 2 1) "> R= "))
R (IF (NOT R) D5 R)
R (IF (> D5 R) D5 R)
RS (- R D5)
RD (+ R D5)
PT (GETPOINT "\n管线起点 <0,0>: ")
PT (IF (/= PT nil) PT (LIST 0 0))
AL1 (/ PI 2) AL2 (- AL1)
PT1 (GETPOINT PT "\n管线下一点 :")
A (ANGLE PT PT1) A1 (+ A AL1) A2 (+ A AL2)
DS (DISTANCE PT1 PT)
P1 (POLAR PT A1 D5)
P2 (POLAR PT A2 D5)
P3 (POLAR P1 A (- DS R))
P4 (POLAR P2 A (- DS R))
PT PT1 FIR P3 SEC P4)
(COMMAND "LINE" P3 P1 "") (SETQ S1 (ENTLAST))
(COMMAND "LINE" P1 P2 P4 "") (SETQ S2 (ENTLAST))
(WHILE (SETQ PT1 (GETPOINT PT "\n管线下一点 :"))
(SETQ A0 (ANGLE PT PT1) A1 (+ A0 AL1) A2 (+ A0 AL2)
DS (DISTANCE PT1 PT)
P1 (POLAR (POLAR PT A1 D5) A0 R)
P2 (POLAR (POLAR PT A2 D5) A0 R)
P3 (POLAR P1 A0 (- DS R R))
P4 (POLAR P2 A0 (- DS R R)))
(COMMAND "LINE" P1 P3 "") (SETQ S3 (ENTLAST))
(COMMAND "LINE" P2 P4 "") (SETQ S4 (ENTLAST))
(IF (> (DISTANCE P1 FIR) (DISTANCE P2 SEC))
(COMMAND "FILLET" "R" RS "FILLET" S2 S4 "FILLET" "R" RD "FILLET" S1 S3)
(COMMAND "FILLET" "R" RD "FILLET" S2 S4 "FILLET" "R" RS "FILLET" S1 S3)
)
(SETQ A A0 PT PT1 S1 S3 S2 S4 FIR P3 SEC P4)
)
(SETQ P1 (POLAR P3 A0 R) P2 (POLAR P4 A0 R))
(COMMAND "STRETCH" "C" P3 P3 "" P3 P1 "STRETCH" "C" P4 P4 "" P4 P2)
(COMMAND "LINE" P1 P2 "")
(SETvar "OSMODE" OLDOS)
(SETvar "CMDECHO" 1)
(PRINC)
)
(PROMPT "\nDRAWPIPE 加载成功。")
(PRINC)
本帖最后由 ZZXXQQ 于 2021-11-4 14:06 编辑
;管线绘制 ZZXXQQ 2004/11/11 2021/11/3
(defun c:drawpipe ()
(setvar "CMDECHO" 0)
(setq OLDOS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq D (getdist "\n输入管子外径 D= <20>")
D (if (not D) 20 D)
D5 (* D 0.5)
R (getreal (strcat "\n输入管子弯曲半径 <大于" (rtos D5 2 1) "> R= "))
R (if (not R) D5 R)
R (if (> D5 R) D5 R)
RS (- R D5)
RD (+ R D5)
PT (getpoint "\n管线起点 <0,0>: ")
PT (if (/= PT nil) PT (list 0 0))
AL1 (/ PI 2) AL2 (- AL1)
PT1 (getpoint PT "\n管线下一点 :")
A (angle PT PT1) A1 (+ A AL1) A2 (+ A AL2)
DS (distance PT1 PT)
P1 (polar PT A1 D5)
P2 (polar PT A2 D5)
P3 (polar P1 A (- DS R))
P4 (polar P2 A (- DS R)))
(entmake (list '(0 . "LINE") (cons 10 PT) (cons 11 PT1) '(8 . "CEN")))
(setq S5 (entlast))
(command "_.LINE" P3 P1 "") (setq S1 (entlast))
(command "_.LINE" P1 P2 P4 "") (setq S2 (entlast))
(setq PT PT1 FIR P3 SEC P4)
(while (setq PT1 (getpoint PT "\n管线下一点 :"))
(entmake (list '(0 . "LINE") (cons 10 PT) (cons 11 PT1) '(8 . "CEN")))
(setq S6 (entlast))
(setq A0 (angle PT PT1) A1 (+ A0 AL1) A2 (+ A0 AL2)
DS (distance PT1 PT)
P1 (polar (polar PT A1 D5) A0 R)
P2 (polar (polar PT A2 D5) A0 R)
P3 (polar P1 A0 (- DS R R))
P4 (polar P2 A0 (- DS R R)))
(command "_.LINE" P1 P3 "") (setq S3 (entlast))
(command "_.LINE" P2 P4 "") (setq S4 (entlast))
(command "_.FILLET" "R" R "_.FILLET" S5 S6)
(if (> (distance P1 FIR) (distance P2 SEC))
(command "_.FILLET" "R" RS "_.FILLET" S2 S4
"_.FILLET" "R" RD "_.FILLET" S1 S3)
(command "_.FILLET" "R" RD "_.FILLET" S2 S4
"_.FILLET" "R" RS "_.FILLET" S1 S3)
)
(setq A A0 PT PT1 S1 S3 S2 S4 FIR P3 SEC P4 S5 S6)
)
(setq P1 (polar P3 A0 R) P2 (polar P4 A0 R))
(command "STRETCH" "C" P3 P3 "" P3 P1 "STRETCH" "C" P4 P4 "" P4 P2)
(command "LINE" P1 P2 "")
(setvar "OSMODE" OLDOS)
(setvar "CMDECHO" 1)
(princ)
)
(prompt "\nDRAWPIPE 加载成功。")
(princ)
楼主你试过了吗，怎么我用会出错 怎么这个程序的代码这么长？感觉不应该这么长才对，就是图元的条件生成吧！不知道楼主有没有动画展示呢？ 这个东西正需要啊 好东西 ZZXXQQ 发表于 2008-2-25 21:28 static/image/common/back.gif
2004年的老程序了。没什么错。下面是修改过的：
非常棒，要是能在双管线中间增加一条中心线就好了，要求中心线线型为center,谢谢 谢谢，学习中 ZZXXQQ 发表于 2008-2-25 21:28 static/image/common/back.gif
2004年的老程序了。没什么错。下面是修改过的：
画风管挺好的啊！ 谢谢，需要重…………………… dddddddddddddddddddddddddddddddd
页:
[1]
2