求助：平面管道弯头生成工具。希望高手帮忙修改一下

huxu823 · 发表于 2022-5-31 11:27

本帖最后由 huxu823 于 2022-5-31 13:17 编辑

命令：GD（用于单线管道变双线管道，也可以生成2条管道交汇处的平面双线弯头）
命令：WT（用于生成两条管道一高一低的平面俯视弯头）

现存在以下2个BUG
1、使用本LISP程序后会修改当前图层为“管道”图层，如何才能在使本程序后恢复到原设置的当前图层呢？
2、想要使用WT命令生成俯视弯头，必须先使用一次GD命令，否则直接使用WT命令会提示：参数类型错误: numberp: nil

这个求助以前发过，没能得到解决，还望高手帮忙看一下，修复以上2个BUG，不胜感激！！！

如果方便的话，能把LSP和DCL合并成一个LSP程序就更好了，研究了怎么把DLC转换成LSP，可是还是不知道怎么把转换后的DCL加到原程序中

;;;;管道中心线----------------------------------------------------
(DEFUN LINECO (SS / SCALE1 INDEX1)
(setq INDEX1 0)
(SETVAR "cmdecho" 0)
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
(REPEAT (SSLENGTH SS)
(command "chprop" (SSNAME SS INDEX1) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "") ;;;;设置管道中心线图层名为Center、颜色为灰色、线型为CENTER、宽为0.15、线型比例为前面设置的当前图层线型比例的100倍
(setq INDEX1 (1+ INDEX1))
)
(SETVAR "cmdecho" 1)
)
;;;;绘制平面弯头的大弯轮廓线----------------------------------------------------
(DEFUN ARCSX (ENAME DIST / BIGARC ENTDATA ENTDATA1 NEWLAYER RNEW RNEWLIST
ROLDLIST SMALLARC SCALE1
)
(SETVAR "cmdecho" 0)
(setq ENTDATA (ENTGET ENAME))
(setq ROLDLIST (ASSOC 40 ENTDATA))
(setq RNEW (CDR ROLDLIST))
(setq RNEW (+ RNEW (* DIST 0.5)))
(setq RNEWLIST (CONS 40 RNEW))
(setq NEWLAYER (CONS 8 (GETVAR "clayer"))) ;;;;平面弯头大轮廓线使用的图层
(setq ENTDATA1 (SUBST
RNEWLIST
ROLDLIST
ENTDATA
)
)
(setq ENTDATA1 (SUBST
NEWLAYER
(ASSOC 8 ENTDATA1)
ENTDATA1
)
)
;;;;设置平面弯头的大弯轮廓线
(ENTMAKE ENTDATA1)
(command "_pedit" (ENTLAST) "W" K "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;绘制平面弯头的小弯轮廓线
(setq BIGARC (vlax-ename->vla-object (ENTLAST)))
(setq RNEW (- RNEW DIST))
(setq RNEWLIST (CONS 40 RNEW))
(setq NEWLAYER (CONS 8 (GETVAR "clayer"))) ;;;;平面弯头小轮廓线使用的图层
(setq ENTDATA1 (SUBST
RNEWLIST
ROLDLIST
ENTDATA
)
)
(setq ENTDATA1 (SUBST
NEWLAYER
(ASSOC 8 ENTDATA1)
ENTDATA1
)
)
;;;;设置平面弯头的小弯轮廓线
(ENTMAKE ENTDATA1)
(command "_pedit" (ENTLAST) "W" K "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;设置平面弯头已倒角中心线
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
(command "chprop" ENAME "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "")
(SETVAR "cmdecho" 0)
(setq SMALLARC (vlax-ename->vla-object (ENTLAST)))
(LIST SMALLARC BIGARC)
)
;;;;绘制管道轮廓线和端线----------------------------------------------------
(DEFUN LINESX (ENAME DIST / ANG ENTDATA PT1 PT2 SXPT1 SXPT2 SXPT3 SXPT4 XK)
(setq XK (* DIST 0.5))
(setq ENTDATA (ENTGET ENAME))
(setq PT1 (CDR (ASSOC 10 ENTDATA)))
(setq PT2 (CDR (ASSOC 11 ENTDATA)))
(setq ANG (+ (ANGLE PT1 PT2) (* 0.5 PI)))
(setq SXPT1 (POLAR PT1 ANG XK))
(setq SXPT2 (POLAR PT2 ANG XK))
(setq ENTDATA1 (ASSOC 0 ENTDATA))
(SETVAR "cmdecho" 0)
;;;;绘制管道第一条轮廓线
(command "pline" SXPT1 "width" K K SXPT2 "")
(command "chprop" (ENTLAST) "" "c" COL "")
(setq ANG (+ PI ANG))
(setq SXPT3 (POLAR PT1 ANG XK))
(setq SXPT4 (POLAR PT2 ANG XK))
;;;;绘制管道第二条轮廓线
(command "pline" SXPT3 "width" K K SXPT4 "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;绘制管道第一条端头线
(command "line" SXPT1 SXPT3 "")
(command "chprop" (ENTLAST) "" "c" 3 "")
;;;;绘制管道第二条端头线
(command "line" SXPT2 SXPT4 "")
(command )
(command "chprop" (ENTLAST) "" "c" 3 "")
(SETVAR "cecolor" OLDCOLOR)
(SETVAR "cmdecho" 1)
)
;;;;绘制同一平面的两根管道带弯头----------------------------------------------------
(DEFUN PIPEFILLET (ENAME1 ENAME2 R L DW / ENTDATA1 ENTDATA2 INTER PT1 PT11
PT12 PT2 PT21 PT22 OLDLAYER ACADOBJ ANG PT3 PT4
PT5 PT6 XXPT1 XXPT2 XXPT3 XXPT4 XK1 R1 ANG12
ENTDATA3
)
(setq ENTDATA1 (ENTGET ENAME1))
(setq ENTDATA2 (ENTGET ENAME2))
(setq PT11 (CDR (ASSOC 10 ENTDATA1)))
(setq PT12 (CDR (ASSOC 11 ENTDATA1)))
(setq PT21 (CDR (ASSOC 10 ENTDATA2)))
(setq PT22 (CDR (ASSOC 11 ENTDATA2)))
(setq INTER (INTERS
PT11
PT12
PT21
PT22
)
)
(setq PT1 (if (> (DISTANCE PT11 INTER) (DISTANCE PT12 INTER))
(PROGN
PT11
)
(PROGN
PT12
)
)
)
(setq PT2 (if (> (DISTANCE PT21 INTER) (DISTANCE PT22 INTER))
(PROGN
PT21
)
(PROGN
PT22
)
)
)
(setq PT3 (POLAR INTER (ANGLE INTER PT1) (* R 1.0)))
(setq PT4 (POLAR INTER (ANGLE INTER PT2) (* R 1.0)))
(setq ANG12 (/ (ABS (- (ANGLE INTER PT1) (ANGLE INTER PT2))) 2))
(if (> L 0)
(PROGN
(if (> ANG12 1.57079)
(PROGN
(setq ANG12 (- 6.283185307 ANG12))
)
)
(setq R1 (* R (/ (COS ANG12) (SIN ANG12))))
(setq PT5 (POLAR INTER (ANGLE INTER PT1) (+ (* R1 1.0) L)))
(setq PT6 (POLAR INTER (ANGLE INTER PT2) (+ (* R1 1.0) L)))
(setq ANG (+ (ANGLE INTER PT1) (* 0.5 PI)))
(setq XK1 (* DW 0.5))
(setq XXPT1 (POLAR PT5 ANG XK1))
(setq ANG (+ PI ANG))
(setq XXPT2 (POLAR PT5 ANG XK1))
(setq ANG (+ (ANGLE INTER PT2) (* 0.5 PI)))
(setq XXPT3 (POLAR PT6 ANG XK1))
(setq ANG (+ PI ANG))
(setq XXPT4 (POLAR PT6 ANG XK1))
)
)
(SETVAR "filletrad" R)
(setq ACADOBJ (vlax-get-acad-object))
(vla-ZoomCenter ACADOBJ (vlax-3d-point INTER) (* R 4.0))
(setq OLDLAYER (GETVAR "clayer")) ;;;;记录当前图层
(SETVAR "cmdecho" 0)
(if (> L 0)
(PROGN
;;;;第一条平面弯头直段长度不为0的端线
(command "line" XXPT1 XXPT2 "")
(command "chprop" (ENTLAST) "" "c" 3 "")
;;;;第二条平面弯头直段长度不为0的端线
(command "line" XXPT3 XXPT4 "")
(command "chprop")
(command "chprop" (ENTLAST) "" "c" 3 "")
)
)
(setq OLDLYTPE (GETVAR "celtype"))
(setq OLDCOLOR (GETVAR "cecolor"))
(SETVAR "clayer" (CDR (ASSOC 8 ENTDATA1))) ;;;;设定当前图层为
(command "fillet" PT3 PT4)
(setq ENTDATA3 (ENTLAST))
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
(SETVAR "clayer" OLDLAYER) ;;;;还原图层为
(SETVAR "cmdecho" 1)
ENTDATA3
)
;;;;绘制管道----------------------------------------------------
(DEFUN PIPESFILLET (LINESS R L DW / ENAME1 ENAME2 ENTDATA1 ENTDATA2 INDEX1
INDEX2 PT1 PT2 PT3 PT4
)
(setq INDEX1 0)
(setq ARCSS (SSADD))
(setq ACADOBJ (vlax-get-acad-object))
(setq ACDOC (vla-get-ActiveDocument ACADOBJ))
(vla-StartUndoMark ACDOC)
(REPEAT (- (SSLENGTH LINESS) 1)
(setq ENAME1 (SSNAME LINESS INDEX1))
(setq ENTDATA1 (ENTGET ENAME1))
(setq PT1 (CDR (ASSOC 10 ENTDATA1)))
(setq PT2 (CDR (ASSOC 11 ENTDATA1)))
(setq INDEX2 (1+ INDEX1))
(while (and
(< INDEX2 (SSLENGTH LINESS))
)
(setq ENAME2 (SSNAME LINESS INDEX2))
(setq INDEX2 (1+ INDEX2))
(setq ENTDATA2 (ENTGET ENAME2))
(setq PT3 (CDR (ASSOC 10 ENTDATA2)))
(setq PT4 (CDR (ASSOC 11 ENTDATA2)))
(if (INTERS
PT1
PT2
PT3
PT4
)
(PROGN
(setq ARCSS (SSADD (PIPEFILLET ENAME1 ENAME2 R L DW) ARCSS))
)
)
)
(setq INDEX1 (1+ INDEX1))
)
(vla-EndUndoMark ACDOC)
ARCSS
)
;;;;管道颜色设置----------------------------------------------------
(DEFUN SET_COLOR (CONM / COSTR)
(DEFUN MAP_COLOR (CKEY MNO)
(START_IMAGE CKEY)
(FILL_IMAGE 0 0 (DIMX_TILE CKEY) (DIMY_TILE CKEY) MNO)
(END_IMAGE)
)
(COND
((= 0 CONM)
(setq COSTR "Byblock")
)
((= 1 CONM)
(setq COSTR "Red")
)
((= 2 CONM)
(setq COSTR "Yellow")
)
((= 3 CONM)
(setq COSTR "Green")
)
((= 4 CONM)
(setq COSTR "Cyan")
)
((= 5 CONM)
(setq COSTR "Bule")
)
((= 6 CONM)
(setq COSTR "Magenta")
)
((= 7 CONM)
(setq COSTR "color")
)
((= 256 CONM)
(setq COSTR "Bylayer")
)
(T
(setq COSTR "")
)
)
(COND
((= 0 COL)
(MAP_COLOR "col" 7)
(setq COL 7)
)
((= 256 COL)
(MAP_COLOR "col" (CDR (ASSOC 62 (TBLSEARCH "layer" LAY))))
(setq COL (CDR (ASSOC 62 (TBLSEARCH "layer" LAY))))
)
(T
(MAP_COLOR "col" CONM)
)
)
(if (= 256 CONM)
(PROGN
(SET_TILE "cnu" (STRCAT "<" (ITOA (CDR (ASSOC 62 (TBLSEARCH "layer"
LAY
)
)
)
) ">" COSTR
)
)
)
(PROGN
(SET_TILE "cnu" (STRCAT "<" (ITOA CONM) ">" COSTR))
)
)
)
;;;;绘制管道颜色等设置窗口
(DEFUN DCL_PIPEDRAW1 ()
(setq DCL_ID (LOAD_DIALOG "pipetest"))
(NEW_DIALOG "pipetest" DCL_ID)
(SET_TILE "pipe_dw" (RTOS PIPE_DW1 2 1))
(SET_TILE "pipe_r" (RTOS PIPE_R1 2 2))
(SET_TILE "pipe_l" (RTOS PIPE_L1 2 2))
(SET_TILE "pipe_w" (RTOS PIPE_W1 2 2))
(setq COL COL1)
(SET_COLOR COL)
(ACTION_TILE "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col))) ")
(ACTION_TILE "accept" "(ok_pipedraw1) (done_dialog 1)")
(START_DIALOG)
)
(DEFUN OK_PIPEDRAW1 ()
(setq DW (ATOF (GET_TILE "pipe_dw")))
(setq R (ATOF (GET_TILE "pipe_r")))
(setq L (ATOF (GET_TILE "pipe_l")))
(setq K (ATOF (GET_TILE "pipe_w")))
(setq PIPE_DW1 (ATOF (GET_TILE "pipe_dw")))
(setq PIPE_R1 (ATOF (GET_TILE "pipe_r")))
(setq PIPE_L1 (ATOF (GET_TILE "pipe_l")))
(setq PIPE_W1 (ATOF (GET_TILE "pipe_w")))
(setq COL1 COL)
)
;;;;绘制管道----------------------------------------------------
(vl-ACAD-defun (DEFUN C:DP (/ ARCSS DW_INDEX DW_LIST ENAME INDEX LINETYPE
PIPESS R_LIST COL DW R L K LAY ENAME1 ENTDATA1
INDEX1 DW R L K
)
(command "layer" "n" "Center" "l" "CENTER" "Center" "c" "8" "Center" "lw" "0.15" "Center" "") ;;;;建立中心线图层
(command "layer" "n" "管道" "l" "continuous" "管道" "c" "2" "管道" "lw" "0.25" "管道" "") ;;;;建立管道轮廓线图层
(setvar "CLAYER" "管道") ;;;设置图层名"管道"为当前图层
(VL-LOAD-COM)
(SETVAR "cmdecho" 0)
(command ".UNDO")
(command "BE")
(setq SNAP (GETVAR "osmode"))
(SETVAR "osmode" 0)
(setq BUK (GETVAR "PICKBOX"))
(SETVAR "PEDITACCEPT" 1)
(OR
PIPE_DW1
(setq PIPE_DW1 250) ;;;;管道外径
)
(OR
PIPE_R1
(setq PIPE_R1 250) ;;;;弯曲半径
)
(OR
PIPE_L1
(setq PIPE_L1 0) ;;;;弯头直段长度
)
(OR
PIPE_W1
(setq PIPE_W1 30) ;;;;管道轮廓线宽度
)
(OR
COL1
(setq COL1 2) ;;;;管道和弯头的轮廓线颜色
)
(PRINC "\n请选择管道中心线: ")
(setq PIPESS (SSGET (LIST (CONS 0 "line"))))
(setq INDEX1 0)
(setq OLDMODE (GETVAR "osmode"))
(SETVAR "osmode" 0)
(setq ENAME1 (SSNAME PIPESS INDEX1))
(setq ENTDATA1 (ENTGET ENAME1))
(setq LAY (CDR (ASSOC 8 ENTDATA1)))
(DCL_PIPEDRAW1)
(setq ARCSS (PIPESFILLET PIPESS R L DW))
(setq INDEX 0)
(LINECO PIPESS)
(REPEAT (SSLENGTH PIPESS)
(setq ENAME (SSNAME PIPESS INDEX))
(setq INDEX (1+ INDEX))
(setq LINETYPE (CDR (ASSOC 0 (ENTGET ENAME))))
(if (= LINETYPE "LINE")
(PROGN
(LINESX ENAME DW)
)
(PROGN
(ARCSX ENAME DW)
)
)
)
(setq INDEX 0)
(REPEAT (SSLENGTH ARCSS)
(setq ENAME (SSNAME ARCSS INDEX))
(setq INDEX (1+ INDEX))
(setq LINETYPE (CDR (ASSOC 0 (ENTGET ENAME))))
(ARCSX ENAME DW)
)
(SETVAR "nomutt" 0)
(SETVAR "PICKBOX" BUK)
(SETVAR "osmode" SNAP)
(command ".UNDO")
(command "E")
(PRINC)
(UNLOAD_DIALOG DCL_ID)
)
)
'C:DP
;;;;绘制弯头颜色等设置窗口
(DEFUN DCL_BENDDRAW ()
(setq DCL_ID (LOAD_DIALOG "pipetest.dcl"))
(NEW_DIALOG "bendtest" DCL_ID)
(SET_TILE "bend_dw" (RTOS PIPE_DW1))
(SET_TILE "bend_r" (RTOS PIPE_R1))
(SET_TILE "bend_w" (RTOS PIPE_W1))
(setq COL 2) ;;;;设置弯头默认颜色为黄色
(SET_COLOR COL)
(ACTION_TILE "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col))) ")
(ACTION_TILE "accept" "(ok_benddraw) (done_dialog 1)")
(START_DIALOG)
)
(DEFUN OK_BENDDRAW ()
(setq POD (ATOF (GET_TILE "bend_dw")))
(setq BR (ATOF (GET_TILE "bend_r")))
(setq K (ATOF (GET_TILE "bend_w")))
(setq POR (/ POD 2))
(setq PIPE_DW1 (ATOF (GET_TILE "bend_dw")))
(setq PIPE_R1 (ATOF (GET_TILE "bend_r")))
(setq PIPE_W1 (ATOF (GET_TILE "bend_w")))
)
;;;;绘制不同平面弯头----------------------------------------------------
(vl-ACAD-defun (DEFUN C:DW (/ PIPESS_G PIPESS_D INDEX1 ENAME1 ENTDATA1
INDEX1 PT11 PT12 PT13 PT14 BCP PT1 PT3 ANG1
ANG2 CSP CEP P11 P12 P13 P14 P21 P22 P23 P24
P31 P32 INT21 INT24 SCALE1 POD BR K POR COL
OLDMODE
)
(command "layer" "n" "Center" "l" "CENTER" "Center" "c" "8" "Center" "lw" "0.15" "Center" "") ;;;;建立中心线图层
(command "layer" "n" "管道" "l" "continuous" "管道" "c" "2" "管道" "lw" "0.25" "管道" "") ;;;;建立管道轮廓线图层
(setvar "CLAYER" "管道") ;;;设置图层名"管道"为当前图层
(VL-LOAD-COM)
(SETVAR "cmdecho" 0)
(command ".UNDO")
(command "BE")
(setq SNAP (GETVAR "osmode"))
(SETVAR "osmode" 0)
(setq BUK (GETVAR "PICKBOX"))
(SETVAR "PEDITACCEPT" 1)
(PRINC "\n请选择高处管道中心线: \n")
(setq PIPESS_G (SSGET (LIST (CONS 0 "line"))))
(PRINC "\n请选择低处管道中心线: \n")
(setq PIPESS_D (SSGET (LIST (CONS 0 "line"))))
(DCL_BENDDRAW)
(setq INDEX1 0)
(setq INT21 nil)
(setq INT24 nil)
(setq ENAME1 (SSNAME PIPESS_G INDEX1))
(setq ENTDATA1 (ENTGET ENAME1))
(setq PT11 (CDR (ASSOC 10 ENTDATA1)))
(setq PT12 (CDR (ASSOC 11 ENTDATA1)))
(setq ENAME1 (SSNAME PIPESS_D INDEX1))
(setq ENTDATA1 (ENTGET ENAME1))
(setq PT13 (CDR (ASSOC 10 ENTDATA1)))
(setq PT14 (CDR (ASSOC 11 ENTDATA1)))
(setq BCP (INTERS
PT11
PT12
PT13
PT14
)
)
(setq PT1 (if (> (DISTANCE PT11 BCP) (DISTANCE PT12 BCP))
(PROGN
PT11
)
(PROGN
PT12
)
)
)
(setq PT3 (if (> (DISTANCE PT13 BCP) (DISTANCE PT14 BCP))
(PROGN
PT13
)
(PROGN
PT14
)
)
)
(setq ANG1 (ANGLE BCP PT1))
(setq ANG2 (ANGLE BCP PT3))
(setq CSP (POLAR BCP ANG1 BR))
(setq CEP (POLAR BCP ANG2 BR))
(setq P11 (POLAR CSP (+ (* PI 0.5) ANG1) POR))
(setq P12 (POLAR BCP (+ (* PI 0.5) ANG1) POR))
(setq P13 (POLAR BCP (+ (* PI 1.5) ANG1) POR))
(setq P14 (POLAR CSP (+ (* PI 1.5) ANG1) POR))
(setq P21 (POLAR BCP (+ (* PI 0.5) ANG2) POR))
(setq P22 (POLAR CEP (+ (/ PI 2) ANG2) POR))
(setq P23 (POLAR CEP (+ (* PI 1.5) ANG2) POR))
(setq P24 (POLAR BCP (+ (* PI 1.5) ANG2) POR))
(setq INT21 (INTERS
P14
P13
P21
P22
)
)
(setq INT24 (INTERS
P11
P12
P24
P23
)
)
(if (NULL INT21)
(PROGN
)
(PROGN
(setq P21 INT21)
)
)
(if (NULL INT24)
(PROGN
)
(PROGN
(setq P24 INT24)
)
)
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
;;;;非同平面弯头的第一条中心线
(command "line" CSP BCP "")
(command "chprop" (ENTLAST) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "")
;;;;非同平面弯头的第二条中心线
(command "line" BCP CEP "")
(command "chprop" (ENTLAST) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "")
;;;;非同平面弯头的第一条轮廓线
(command "pline" P11 "w" K K P12 "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;非同平面弯头的第二条轮廓线
(command "pline" P12 "w" K K "a" "a" 180 "c" BCP "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;非同平面弯头的第三条轮廓线
(command "pline" P13 "w" K K P14 "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;非同平面弯头的第四条端头线
(command "line" P14 P11 "")
(command "chprop" (ENTLAST) "" "c" 3 "")
;;;;非同平面弯头的第五条轮廓线
(command "pline" P21 "w" K K P22 "")
(command "chprop" (ENTLAST) "" "c" COL "")
;;;;非同平面弯头的第六条端头线
(command "line" P22 P23 "")
(command "chprop" (ENTLAST) "" "c" 3 "")
;;;;非同平面弯头的第七条轮廓线
(command "pline" P23 "w" K K P24 "")
(command "chprop" (ENTLAST) "" "c" COL "")
(SETVAR "cmdecho" 1)
(SETVAR "osmode" OLDMODE)
(UNLOAD_DIALOG DCL_ID)
(SETVAR "nomutt" 0)
(SETVAR "PICKBOX" BUK)
(SETVAR "osmode" SNAP)
(command ".UNDO")
(command "E")
(PRINC)
)
)
'C:DW
(PRINC)
(PRINC "\n 单线管变双线管，起动命令："dp"\n")
(PRINC "\n 画上下弯头，起动命令："dw"\n")
(PRINC)

;;;;管道中心线---------------------------------------------------- 
(DEFUN LINECO (SS / SCALE1 INDEX1) 
  (setq INDEX1 0) 
  (SETVAR "cmdecho" 0) 
  (setq SCALE1 (/ 100 (GETVAR "LTSCALE"))) 
  (REPEAT (SSLENGTH SS) 
    (command "chprop" (SSNAME SS INDEX1) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "")      ;;;;设置管道中心线图层名为Center、颜色为灰色、线型为CENTER、宽为0.15、线型比例为前面设置的当前图层线型比例的100倍 
    (setq INDEX1 (1+ INDEX1)) 
  ) 
  (SETVAR "cmdecho" 1) 
) 
 
 
;;;;绘制平面弯头的大弯轮廓线---------------------------------------------------- 
(DEFUN ARCSX (ENAME DIST / BIGARC ENTDATA ENTDATA1 NEWLAYER RNEW RNEWLIST 
        ROLDLIST SMALLARC SCALE1 
       ) 
  (SETVAR "cmdecho" 0) 
  (setq ENTDATA (ENTGET ENAME)) 
  (setq ROLDLIST (ASSOC 40 ENTDATA)) 
  (setq RNEW (CDR ROLDLIST)) 
  (setq RNEW (+ RNEW (* DIST 0.5))) 
  (setq RNEWLIST (CONS 40 RNEW)) 
  (setq NEWLAYER (CONS 8 (GETVAR "clayer")))    ;;;;平面弯头大轮廓线使用的图层 
  (setq ENTDATA1 (SUBST 
       RNEWLIST 
       ROLDLIST 
       ENTDATA 
     ) 
  ) 
  (setq ENTDATA1 (SUBST 
       NEWLAYER 
       (ASSOC 8 ENTDATA1) 
       ENTDATA1 
     ) 
  ) 
   
  ;;;;设置平面弯头的大弯轮廓线 
  (ENTMAKE ENTDATA1) 
  (command "_pedit" (ENTLAST) "W" K "") 
  (command "chprop" (ENTLAST) "" "c" COL "") 
 
  ;;;;绘制平面弯头的小弯轮廓线 
  (setq BIGARC (vlax-ename->vla-object (ENTLAST))) 
  (setq RNEW (- RNEW DIST)) 
  (setq RNEWLIST (CONS 40 RNEW)) 
  (setq NEWLAYER (CONS 8 (GETVAR "clayer")))    ;;;;平面弯头小轮廓线使用的图层 
  (setq ENTDATA1 (SUBST 
       RNEWLIST 
       ROLDLIST 
       ENTDATA 
     ) 
  ) 
  (setq ENTDATA1 (SUBST 
       NEWLAYER 
       (ASSOC 8 ENTDATA1) 
       ENTDATA1 
     ) 
  ) 
   
  ;;;;设置平面弯头的小弯轮廓线 
  (ENTMAKE ENTDATA1) 
  (command "_pedit" (ENTLAST) "W" K "") 
  (command "chprop" (ENTLAST) "" "c" COL "") 
   
  ;;;;设置平面弯头已倒角中心线 
  (setq SCALE1 (/ 100 (GETVAR "LTSCALE"))) 
  (command "chprop" ENAME "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "") 
  (SETVAR "cmdecho" 0) 
  (setq SMALLARC (vlax-ename->vla-object (ENTLAST))) 
  (LIST SMALLARC BIGARC) 
) 
 
 
;;;;绘制管道轮廓线和端线---------------------------------------------------- 
(DEFUN LINESX (ENAME DIST / ANG ENTDATA PT1 PT2 SXPT1 SXPT2 SXPT3 SXPT4 XK) 
  (setq XK (* DIST 0.5)) 
  (setq ENTDATA (ENTGET ENAME)) 
  (setq PT1 (CDR (ASSOC 10 ENTDATA))) 
  (setq PT2 (CDR (ASSOC 11 ENTDATA))) 
  (setq ANG (+ (ANGLE PT1 PT2) (* 0.5 PI))) 
  (setq SXPT1 (POLAR PT1 ANG XK)) 
  (setq SXPT2 (POLAR PT2 ANG XK)) 
  (setq ENTDATA1 (ASSOC 0 ENTDATA)) 
  (SETVAR "cmdecho" 0) 
   
  ;;;;绘制管道第一条轮廓线 
  (command "pline" SXPT1 "width" K K SXPT2 "") 
  (command "chprop" (ENTLAST) "" "c" COL "") 
  (setq ANG (+ PI ANG)) 
  (setq SXPT3 (POLAR PT1 ANG XK)) 
  (setq SXPT4 (POLAR PT2 ANG XK)) 
   
  ;;;;绘制管道第二条轮廓线 
  (command "pline" SXPT3 "width" K K SXPT4 "") 
  (command "chprop" (ENTLAST) "" "c" COL "") 
 
  ;;;;绘制管道第一条端头线 
  (command "line" SXPT1 SXPT3 "") 
  (command "chprop" (ENTLAST) "" "c" 3 "") 
 
  ;;;;绘制管道第二条端头线 
  (command "line" SXPT2 SXPT4 "") 
  (command ) 
  (command "chprop" (ENTLAST) "" "c" 3 "") 
 
  (SETVAR "cecolor" OLDCOLOR) 
  (SETVAR "cmdecho" 1) 
) 
 
 
;;;;绘制同一平面的两根管道带弯头---------------------------------------------------- 
(DEFUN PIPEFILLET (ENAME1 ENAME2 R L DW / ENTDATA1 ENTDATA2 INTER PT1 PT11 
        PT12 PT2 PT21 PT22 OLDLAYER ACADOBJ ANG PT3 PT4 
        PT5 PT6 XXPT1 XXPT2 XXPT3 XXPT4 XK1 R1 ANG12 
        ENTDATA3 
      ) 
  (setq ENTDATA1 (ENTGET ENAME1)) 
  (setq ENTDATA2 (ENTGET ENAME2)) 
  (setq PT11 (CDR (ASSOC 10 ENTDATA1))) 
  (setq PT12 (CDR (ASSOC 11 ENTDATA1))) 
  (setq PT21 (CDR (ASSOC 10 ENTDATA2))) 
  (setq PT22 (CDR (ASSOC 11 ENTDATA2))) 
  (setq INTER (INTERS 
    PT11 
    PT12 
    PT21 
    PT22 
        ) 
  ) 
  (setq PT1 (if (> (DISTANCE PT11 INTER) (DISTANCE PT12 INTER)) 
        (PROGN 
    PT11 
        ) 
        (PROGN 
    PT12 
        ) 
      ) 
  ) 
  (setq PT2 (if (> (DISTANCE PT21 INTER) (DISTANCE PT22 INTER)) 
        (PROGN 
    PT21 
        ) 
        (PROGN 
    PT22 
        ) 
      ) 
  ) 
  (setq PT3 (POLAR INTER (ANGLE INTER PT1) (* R 1.0))) 
  (setq PT4 (POLAR INTER (ANGLE INTER PT2) (* R 1.0))) 
  (setq ANG12 (/ (ABS (- (ANGLE INTER PT1) (ANGLE INTER PT2))) 2)) 
  (if (> L 0) 
    (PROGN 
      (if (> ANG12 1.57079) 
  (PROGN 
    (setq ANG12 (- 6.283185307 ANG12)) 
  ) 
      ) 
      (setq R1 (* R (/ (COS ANG12) (SIN ANG12)))) 
      (setq PT5 (POLAR INTER (ANGLE INTER PT1) (+ (* R1 1.0) L))) 
      (setq PT6 (POLAR INTER (ANGLE INTER PT2) (+ (* R1 1.0) L))) 
      (setq ANG (+ (ANGLE INTER PT1) (* 0.5 PI))) 
      (setq XK1 (* DW 0.5)) 
      (setq XXPT1 (POLAR PT5 ANG XK1)) 
      (setq ANG (+ PI ANG)) 
      (setq XXPT2 (POLAR PT5 ANG XK1)) 
      (setq ANG (+ (ANGLE INTER PT2) (* 0.5 PI))) 
      (setq XXPT3 (POLAR PT6 ANG XK1)) 
      (setq ANG (+ PI ANG)) 
      (setq XXPT4 (POLAR PT6 ANG XK1)) 
    ) 
  ) 
  (SETVAR "filletrad" R) 
  (setq ACADOBJ (vlax-get-acad-object)) 
  (vla-ZoomCenter ACADOBJ (vlax-3d-point INTER) (* R 4.0)) 
  (setq OLDLAYER (GETVAR "clayer"))    ;;;;记录当前图层 
  (SETVAR "cmdecho" 0) 
  (if (> L 0) 
    (PROGN 
      ;;;;第一条平面弯头直段长度不为0的端线 
      (command "line" XXPT1 XXPT2 "") 
      (command "chprop" (ENTLAST) "" "c" 3 "") 
      ;;;;第二条平面弯头直段长度不为0的端线 
      (command "line" XXPT3 XXPT4 "") 
      (command "chprop") 
      (command "chprop" (ENTLAST) "" "c" 3 "") 
    ) 
  ) 
  (setq OLDLYTPE (GETVAR "celtype")) 
  (setq OLDCOLOR (GETVAR "cecolor")) 
  (SETVAR "clayer" (CDR (ASSOC 8 ENTDATA1)))    ;;;;设定当前图层为 
  (command "fillet" PT3 PT4) 
  (setq ENTDATA3 (ENTLAST)) 
  (setq SCALE1 (/ 100 (GETVAR "LTSCALE"))) 
   
  (SETVAR "clayer" OLDLAYER)        ;;;;还原图层为 
  (SETVAR "cmdecho" 1) 
  ENTDATA3 
) 
 
 
;;;;绘制管道---------------------------------------------------- 
(DEFUN PIPESFILLET (LINESS R L DW / ENAME1 ENAME2 ENTDATA1 ENTDATA2 INDEX1 
         INDEX2 PT1 PT2 PT3 PT4 
       ) 
  (setq INDEX1 0) 
  (setq ARCSS (SSADD)) 
  (setq ACADOBJ (vlax-get-acad-object)) 
  (setq ACDOC (vla-get-ActiveDocument ACADOBJ)) 
  (vla-StartUndoMark ACDOC) 
  (REPEAT (- (SSLENGTH LINESS) 1) 
    (setq ENAME1 (SSNAME LINESS INDEX1)) 
    (setq ENTDATA1 (ENTGET ENAME1)) 
    (setq PT1 (CDR (ASSOC 10 ENTDATA1))) 
    (setq PT2 (CDR (ASSOC 11 ENTDATA1))) 
    (setq INDEX2 (1+ INDEX1)) 
    (while (and 
       (< INDEX2 (SSLENGTH LINESS)) 
     ) 
      (setq ENAME2 (SSNAME LINESS INDEX2)) 
      (setq INDEX2 (1+ INDEX2)) 
      (setq ENTDATA2 (ENTGET ENAME2)) 
      (setq PT3 (CDR (ASSOC 10 ENTDATA2))) 
      (setq PT4 (CDR (ASSOC 11 ENTDATA2))) 
      (if (INTERS 
      PT1 
      PT2 
      PT3 
      PT4 
    ) 
  (PROGN 
    (setq ARCSS (SSADD (PIPEFILLET ENAME1 ENAME2 R L DW) ARCSS)) 
  ) 
      ) 
    ) 
    (setq INDEX1 (1+ INDEX1)) 
  ) 
  (vla-EndUndoMark ACDOC) 
  ARCSS 
) 
 
 
;;;;管道颜色设置---------------------------------------------------- 
(DEFUN SET_COLOR (CONM / COSTR) 
  (DEFUN MAP_COLOR (CKEY MNO) 
    (START_IMAGE CKEY) 
    (FILL_IMAGE 0 0 (DIMX_TILE CKEY) (DIMY_TILE CKEY) MNO) 
    (END_IMAGE) 
  ) 
  (COND 
    ((= 0 CONM) 
      (setq COSTR "Byblock") 
    ) 
    ((= 1 CONM) 
      (setq COSTR "Red") 
    ) 
    ((= 2 CONM) 
      (setq COSTR "Yellow") 
    ) 
    ((= 3 CONM) 
      (setq COSTR "Green") 
    ) 
    ((= 4 CONM) 
      (setq COSTR "Cyan") 
    ) 
    ((= 5 CONM) 
      (setq COSTR "Bule") 
    ) 
    ((= 6 CONM) 
      (setq COSTR "Magenta") 
    ) 
    ((= 7 CONM) 
      (setq COSTR "color") 
    ) 
    ((= 256 CONM) 
      (setq COSTR "Bylayer") 
    ) 
    (T 
      (setq COSTR "") 
    ) 
  ) 
  (COND 
    ((= 0 COL) 
      (MAP_COLOR "col" 7) 
      (setq COL 7) 
    ) 
    ((= 256 COL) 
      (MAP_COLOR "col" (CDR (ASSOC 62 (TBLSEARCH "layer" LAY)))) 
      (setq COL (CDR (ASSOC 62 (TBLSEARCH "layer" LAY)))) 
    ) 
    (T 
      (MAP_COLOR "col" CONM) 
    ) 
  ) 
  (if (= 256 CONM) 
    (PROGN 
      (SET_TILE "cnu" (STRCAT "<" (ITOA (CDR (ASSOC 62 (TBLSEARCH "layer" 
                  LAY 
                   ) 
               ) 
          ) 
          ) ">" COSTR 
          ) 
      ) 
    ) 
    (PROGN 
      (SET_TILE "cnu" (STRCAT "<" (ITOA CONM) ">" COSTR)) 
    ) 
  ) 
) 
 
;;;;绘制管道颜色等设置窗口 
(DEFUN DCL_PIPEDRAW1 () 
  (setq DCL_ID (LOAD_DIALOG "pipetest")) 
  (NEW_DIALOG "pipetest" DCL_ID) 
  (SET_TILE "pipe_dw" (RTOS PIPE_DW1 2 1)) 
  (SET_TILE "pipe_r" (RTOS PIPE_R1 2 2)) 
  (SET_TILE "pipe_l" (RTOS PIPE_L1 2 2)) 
  (SET_TILE "pipe_w" (RTOS PIPE_W1 2 2)) 
  (setq COL COL1) 
  (SET_COLOR COL) 
  (ACTION_TILE "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col))) ") 
  (ACTION_TILE "accept" "(ok_pipedraw1) (done_dialog 1)") 
  (START_DIALOG) 
) 
 
 
(DEFUN OK_PIPEDRAW1 () 
  (setq DW (ATOF (GET_TILE "pipe_dw"))) 
  (setq R (ATOF (GET_TILE "pipe_r"))) 
  (setq L (ATOF (GET_TILE "pipe_l"))) 
  (setq K (ATOF (GET_TILE "pipe_w"))) 
  (setq PIPE_DW1 (ATOF (GET_TILE "pipe_dw"))) 
  (setq PIPE_R1 (ATOF (GET_TILE "pipe_r"))) 
  (setq PIPE_L1 (ATOF (GET_TILE "pipe_l"))) 
  (setq PIPE_W1 (ATOF (GET_TILE "pipe_w"))) 
  (setq COL1 COL) 
) 
 
 
;;;;绘制管道---------------------------------------------------- 
(vl-ACAD-defun (DEFUN C:DP (/ ARCSS DW_INDEX DW_LIST ENAME INDEX LINETYPE 
            PIPESS R_LIST COL DW R L K LAY ENAME1 ENTDATA1 
            INDEX1 DW R L K 
         ) 
      
         (command "layer" "n" "Center" "l" "CENTER" "Center" "c" "8" "Center" "lw" "0.15" "Center" "")    ;;;;建立中心线图层 
         (command "layer" "n" "管道" "l" "continuous" "管道" "c" "2" "管道" "lw" "0.25" "管道" "")      ;;;;建立管道轮廓线图层 
     (setvar "CLAYER" "管道")   ;;;设置图层名"管道"为当前图层 
     (VL-LOAD-COM) 
     (SETVAR "cmdecho" 0) 
     (command ".UNDO") 
     (command "BE") 
     (setq SNAP (GETVAR "osmode")) 
     (SETVAR "osmode" 0) 
     (setq BUK (GETVAR "PICKBOX")) 
     (SETVAR "PEDITACCEPT" 1) 
     (OR 
       PIPE_DW1 
       (setq PIPE_DW1 250)    ;;;;管道外径 
     ) 
     (OR 
       PIPE_R1 
       (setq PIPE_R1 250)     ;;;;弯曲半径 
     ) 
     (OR 
       PIPE_L1 
       (setq PIPE_L1 0)       ;;;;弯头直段长度 
     ) 
     (OR 
       PIPE_W1 
       (setq PIPE_W1 30)      ;;;;管道轮廓线宽度 
     ) 
     (OR 
       COL1 
       (setq COL1 2)          ;;;;管道和弯头的轮廓线颜色 
     ) 
     (PRINC "\n请选择管道中心线: ") 
     (setq PIPESS (SSGET (LIST (CONS 0 "line")))) 
     (setq INDEX1 0) 
     (setq OLDMODE (GETVAR "osmode")) 
     (SETVAR "osmode" 0) 
     (setq ENAME1 (SSNAME PIPESS INDEX1)) 
     (setq ENTDATA1 (ENTGET ENAME1)) 
     (setq LAY (CDR (ASSOC 8 ENTDATA1))) 
     (DCL_PIPEDRAW1) 
     (setq ARCSS (PIPESFILLET PIPESS R L DW)) 
     (setq INDEX 0) 
     (LINECO PIPESS) 
     (REPEAT (SSLENGTH PIPESS) 
       (setq ENAME (SSNAME PIPESS INDEX)) 
       (setq INDEX (1+ INDEX)) 
       (setq LINETYPE (CDR (ASSOC 0 (ENTGET ENAME)))) 
       (if (= LINETYPE "LINE") 
         (PROGN 
           (LINESX ENAME DW) 
         ) 
         (PROGN 
           (ARCSX ENAME DW) 
         ) 
       ) 
     ) 
     (setq INDEX 0) 
     (REPEAT (SSLENGTH ARCSS) 
       (setq ENAME (SSNAME ARCSS INDEX)) 
       (setq INDEX (1+ INDEX)) 
       (setq LINETYPE (CDR (ASSOC 0 (ENTGET ENAME)))) 
       (ARCSX ENAME DW) 
     ) 
     (SETVAR "nomutt" 0) 
     (SETVAR "PICKBOX" BUK) 
     (SETVAR "osmode" SNAP) 
     (command ".UNDO") 
     (command "E") 
     (PRINC) 
     (UNLOAD_DIALOG DCL_ID) 
         ) 
) 
'C:DP 
 
 
;;;;绘制弯头颜色等设置窗口 
(DEFUN DCL_BENDDRAW () 
  (setq DCL_ID (LOAD_DIALOG "pipetest.dcl")) 
  (NEW_DIALOG "bendtest" DCL_ID) 
  (SET_TILE "bend_dw" (RTOS PIPE_DW1)) 
  (SET_TILE "bend_r" (RTOS PIPE_R1)) 
  (SET_TILE "bend_w" (RTOS PIPE_W1)) 
  (setq COL 2)    ;;;;设置弯头默认颜色为黄色 
  (SET_COLOR COL) 
  (ACTION_TILE "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col))) ") 
  (ACTION_TILE "accept" "(ok_benddraw) (done_dialog 1)") 
  (START_DIALOG) 
) 
 
 
(DEFUN OK_BENDDRAW () 
  (setq POD (ATOF (GET_TILE "bend_dw"))) 
  (setq BR (ATOF (GET_TILE "bend_r"))) 
  (setq K (ATOF (GET_TILE "bend_w"))) 
  (setq POR (/ POD 2)) 
  (setq PIPE_DW1 (ATOF (GET_TILE "bend_dw"))) 
  (setq PIPE_R1 (ATOF (GET_TILE "bend_r"))) 
  (setq PIPE_W1 (ATOF (GET_TILE "bend_w"))) 
) 
 
 
;;;;绘制不同平面弯头---------------------------------------------------- 
(vl-ACAD-defun (DEFUN C:DW (/ PIPESS_G PIPESS_D INDEX1 ENAME1 ENTDATA1 
            INDEX1 PT11 PT12 PT13 PT14 BCP PT1 PT3 ANG1 
            ANG2 CSP CEP P11 P12 P13 P14 P21 P22 P23 P24 
            P31 P32 INT21 INT24 SCALE1 POD BR K POR COL 
            OLDMODE 
         ) 
         (command "layer" "n" "Center" "l" "CENTER" "Center" "c" "8" "Center" "lw" "0.15" "Center" "")    ;;;;建立中心线图层 
         (command "layer" "n" "管道" "l" "continuous" "管道" "c" "2" "管道" "lw" "0.25" "管道" "")      ;;;;建立管道轮廓线图层 
     (setvar "CLAYER" "管道")   ;;;设置图层名"管道"为当前图层 
     (VL-LOAD-COM) 
     (SETVAR "cmdecho" 0) 
     (command ".UNDO") 
     (command "BE") 
     (setq SNAP (GETVAR "osmode")) 
     (SETVAR "osmode" 0) 
     (setq BUK (GETVAR "PICKBOX")) 
     (SETVAR "PEDITACCEPT" 1) 
     (PRINC "\n请选择高处管道中心线: \n") 
     (setq PIPESS_G (SSGET (LIST (CONS 0 "line")))) 
     (PRINC "\n请选择低处管道中心线: \n") 
     (setq PIPESS_D (SSGET (LIST (CONS 0 "line")))) 
     (DCL_BENDDRAW) 
     (setq INDEX1 0) 
     (setq INT21 nil) 
     (setq INT24 nil) 
     (setq ENAME1 (SSNAME PIPESS_G INDEX1)) 
     (setq ENTDATA1 (ENTGET ENAME1)) 
     (setq PT11 (CDR (ASSOC 10 ENTDATA1))) 
     (setq PT12 (CDR (ASSOC 11 ENTDATA1))) 
     (setq ENAME1 (SSNAME PIPESS_D INDEX1)) 
     (setq ENTDATA1 (ENTGET ENAME1)) 
     (setq PT13 (CDR (ASSOC 10 ENTDATA1))) 
     (setq PT14 (CDR (ASSOC 11 ENTDATA1))) 
     (setq BCP (INTERS 
           PT11 
           PT12 
           PT13 
           PT14 
         ) 
     ) 
     (setq PT1 (if (> (DISTANCE PT11 BCP) (DISTANCE PT12 BCP)) 
           (PROGN 
             PT11 
           ) 
           (PROGN 
             PT12 
           ) 
         ) 
     ) 
     (setq PT3 (if (> (DISTANCE PT13 BCP) (DISTANCE PT14 BCP)) 
           (PROGN 
             PT13 
           ) 
           (PROGN 
             PT14 
           ) 
         ) 
     ) 
     (setq ANG1 (ANGLE BCP PT1)) 
     (setq ANG2 (ANGLE BCP PT3)) 
     (setq CSP (POLAR BCP ANG1 BR)) 
     (setq CEP (POLAR BCP ANG2 BR)) 
     (setq P11 (POLAR CSP (+ (* PI 0.5) ANG1) POR)) 
     (setq P12 (POLAR BCP (+ (* PI 0.5) ANG1) POR)) 
     (setq P13 (POLAR BCP (+ (* PI 1.5) ANG1) POR)) 
     (setq P14 (POLAR CSP (+ (* PI 1.5) ANG1) POR)) 
     (setq P21 (POLAR BCP (+ (* PI 0.5) ANG2) POR)) 
     (setq P22 (POLAR CEP (+ (/ PI 2) ANG2) POR)) 
     (setq P23 (POLAR CEP (+ (* PI 1.5) ANG2) POR)) 
     (setq P24 (POLAR BCP (+ (* PI 1.5) ANG2) POR)) 
     (setq INT21 (INTERS 
             P14 
             P13 
             P21 
             P22 
           ) 
     ) 
     (setq INT24 (INTERS 
             P11 
             P12 
             P24 
             P23 
           ) 
     ) 
     (if (NULL INT21) 
       (PROGN 
       ) 
       (PROGN 
         (setq P21 INT21) 
       ) 
     ) 
     (if (NULL INT24) 
       (PROGN 
       ) 
       (PROGN 
         (setq P24 INT24) 
       ) 
     ) 
     (setq SCALE1 (/ 100 (GETVAR "LTSCALE"))) 
      
     ;;;;非同平面弯头的第一条中心线 
     (command "line" CSP BCP "") 
     (command "chprop" (ENTLAST) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "") 
      
     ;;;;非同平面弯头的第二条中心线 
     (command "line" BCP CEP "") 
     (command "chprop" (ENTLAST) "" "layer" "Center" "c" "8" "LT" "CENTER" "LW" "0.15" "S" SCALE1 "") 
      
     ;;;;非同平面弯头的第一条轮廓线 
     (command "pline" P11 "w" K K P12 "") 
     (command "chprop" (ENTLAST) "" "c" COL "") 
      
     ;;;;非同平面弯头的第二条轮廓线 
     (command "pline" P12 "w" K K "a" "a" 180 "c" BCP "") 
     (command "chprop" (ENTLAST) "" "c" COL "") 
      
     ;;;;非同平面弯头的第三条轮廓线 
     (command "pline" P13 "w" K K P14 "") 
     (command "chprop" (ENTLAST) "" "c" COL "") 
      
     ;;;;非同平面弯头的第四条端头线 
     (command "line" P14 P11 "") 
     (command "chprop" (ENTLAST) "" "c" 3 "") 
      
     ;;;;非同平面弯头的第五条轮廓线 
     (command "pline" P21 "w" K K P22 "") 
     (command "chprop" (ENTLAST) "" "c" COL "") 
      
     ;;;;非同平面弯头的第六条端头线 
     (command "line" P22 P23 "") 
     (command "chprop" (ENTLAST) "" "c" 3 "") 
      
     ;;;;非同平面弯头的第七条轮廓线 
     (command "pline" P23 "w" K K P24 "") 
     (command "chprop" (ENTLAST) "" "c" COL "") 
      
     (SETVAR "cmdecho" 1) 
     (SETVAR "osmode" OLDMODE) 
     (UNLOAD_DIALOG DCL_ID) 
     (SETVAR "nomutt" 0) 
     (SETVAR "PICKBOX" BUK) 
     (SETVAR "osmode" SNAP) 
     (command ".UNDO") 
     (command "E") 
     (PRINC) 
         ) 
) 
'C:DW 
 
(PRINC) 
(PRINC "\n  单线管变双线管，起动命令："dp"\n") 
(PRINC "\n  画上下弯头，   起动命令："dw"\n") 
(PRINC)

huxu823 · 发表于 2022-5-31 14:16

能否麻烦斑竹将此贴移到“AutoLISP/Visual LISP” 编程技术版块？

xyp1964 · 发表于 2022-5-31 18:58

竟然敢明目张胆搞破解

huxu823 · 发表于 2022-5-31 19:00

xyp1964 发表于 2022-5-31 18:58
竟然敢明目张胆搞破解

不知道从哪里找来的了，你觉得我会破解？

start4444 · 发表于 2022-5-31 22:24

这是怎么用的，运行有问题

huxu823 · 发表于 2022-6-1 15:48

start4444 发表于 2022-5-31 22:24
这是怎么用的，运行有问题

我用的CAD2007可以使用，其他版本CAD没用过

liweihua-1984 · 发表于 2022-11-20 11:14

单线变双线管道，单线为PL线。

bonny · 发表于 2022-11-20 13:00

一直以为都是加分的，居然还可以减分

账号		自动登录	找回密码
密码			注册

[提问] 求助：平面管道弯头生成工具。希望高手帮忙修改一下

评分

本帖子中包含更多资源