求助：单线管道变双线管道，可以生成弯头。希望高手修改一下，使之不改变当前图层
本帖最后由 huxu823 于 2020-8-9 15:30 编辑单线管变双线管带中心线的源码，从论坛里扒来的，原程序生成的双线管道、弯头和中心线都是使用的当前图层，而且管道和弯头的端线是多段粗线，这样的话，如果当前图层的线是粗线的话，画出来的中心线也是粗线，会比较难看。所以根据本人自身绘图需要，做了一些小的修改，比如：将管道的轮廓线改为了“管道”图层，中心线改成了“Center”图层，将管道和弯头的端线改成了“管道”图层的细线
命令：GD（用于单线管道变双线管道，也可以生成2条管道交汇处的平面双线弯头）
命令：WT（用于生成两条管道一高一低的平面俯视弯头）
现存在以下2个BUG
1、使用本LISP程序后会修改当前图层为“管道”图层，如何才能使本程序在画图过程中不因使用本程序而改变当前图层呢？
2、想要使用WT命令生成俯视弯头，必须先使用一次GD命令，否则提示：参数类型错误: numberp: nil
求高手帮忙看一下，修复以上2个BUG，不胜感激！！！
(DEFUN LINECO (SS / SCALE1 INDEX1)
(setq DCL (load_dialog (make-dcl)))
(setq INDEX1 0)
(SETVAR "cmdecho" 0)
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
(REPEAT (SSLENGTH SS)
(command "chprop")
(command (SSNAME SS INDEX1))
(command "")
(command "layer" "Center") ;;;;设置管道中心线图层为Center
(command "c" "8") ;;;;设置管道中心线颜色为灰色
(command "LT" "CENTER") ;;;;设置管道中心线线型为CENTER
(command "LW" "0.15") ;;;;设置管道中心线线宽为0.15
(command "S" SCALE1) ;;;;设置管道中心线比例为当前图层线型比例的100倍
(command "")
(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")
(command (ENTLAST))
(command "W")
(command K)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
(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")
(command (ENTLAST))
(command "W")
(command K)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
(command "chprop")
(command ENAME)
(command "")
(command "layer" "Center") ;;;;设置管道中心线图层为Center
(command "c" "8") ;;;;设置管道中心线颜色为灰色
(command "LT" "CENTER") ;;;;设置管道中心线线型为CENTER
(command "LW" "0.15") ;;;;设置管道中心线线宽为0.15
(command "S" SCALE1) ;;;;设置管道中心线比例为当前图层线型比例的100倍
(command "")
(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")
(command SXPT1)
(command "width")
(command K)
(command K)
(command SXPT2)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
(setq ANG (+ PI ANG))
(setq SXPT3 (POLAR PT1 ANG XK))
(setq SXPT4 (POLAR PT2 ANG XK))
;;;;管道第二条轮廓线
(command "pline")
(command SXPT3)
(command "width")
(command K)
(command K)
(command SXPT4)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
;;;;管道第一条端线
(command "line")
(command SXPT1)
(command SXPT3)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
;;;;管道第二条端线
(command "line")
(command SXPT2)
(command SXPT4)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
(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")
(command XXPT1)
(command XXPT2)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
;;;;第二条平面弯头直段长度不为0的端线
(command "line")
(command XXPT3)
(command XXPT4)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
)
)
(setq OLDLYTPE (GETVAR "celtype"))
(setq OLDCOLOR (GETVAR "cecolor"))
(SETVAR "clayer" (CDR (ASSOC 8 ENTDATA1))) ;;;;设定当前图层为
(command "fillet")
(command PT3)
(command PT4)
(setq ENTDATA3 (ENTLAST))
(setq SCALE1 (/ 100 (GETVAR "LTSCALE")))
;;;;第一条平面弯头未倒角的中心线
;;(ENTMAKE (LIST '(0 . "LINE") (CONS 10 PT3) (CONS 11 INTER)))
;;(command "chprop")
;;(command (ENTLAST))
;;(command "")
;;(command "layer" "Center") ;;;;设置平面弯头中心线图层为Center
;;(command "c" "1") ;;;;设置平面弯头中心线颜色为红色
;;(command "LT" "CENTER") ;;;;设置平面弯头中心线线型为CENTER
;;(command "LW" "0.15") ;;;;设置平面弯头中心线线宽为0.15
;;(command "S" SCALE1) ;;;;设置平面弯头中心线比例为当前图层线型比例的100倍
;;(command "")
;;;;第二条平面弯头未倒角的中心线
;;(ENTMAKE (LIST '(0 . "LINE") (CONS 10 PT4) (CONS 11 INTER)))
;;(command "chprop")
;;(command (ENTLAST))
;;(command "")
;;(command "layer" "Center") ;;;;设置平面弯头中心线图层为Center
;;(command "c" "1") ;;;;设置平面弯头中心线颜色为红色
;;(command "LT" "CENTER") ;;;;设置平面弯头中心线线型为CENTER
;;(command "LW" "0.15") ;;;;设置平面弯头中心线线宽为0.15
;;(command "S" SCALE1) ;;;;设置平面弯头中心线比例为当前图层线型比例的100倍
;;(command "")
(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:GD (/ 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:GD
(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:WT (/ 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")
(command CSP)
(command BCP)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "layer" "Center") ;;;;设置弯头中心线图层为Center
(command "c" "8") ;;;;设置弯头中心线颜色为灰色
(command "LT" "CENTER") ;;;;设置弯头中心线线型为CENTER
(command "LW" "0.15") ;;;;设置弯头中心线线宽为0.15
(command "S" SCALE1) ;;;;设置弯头中心线比例为当前图层线型比例的100倍
(command "")
;;;;非同一平面弯头的第二条中心线
(command "line")
(command BCP)
(command CEP)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "layer" "Center") ;;;;设置弯头中心线图层为Center
(command "c" "8") ;;;;设置弯头中心线颜色为灰色
(command "LT" "CENTER") ;;;;设置弯头中心线线型为CENTER
(command "LW" "0.15") ;;;;设置弯头中心线线宽为0.15
(command "S" SCALE1) ;;;;设置弯头中心线比例为当前图层线型比例的100倍
(command "")
;;;;非同一平面弯头的第一条线：轮廓线
(command "pline")
(command P11)
(command "w")
(command K)
(command K)
(command P12)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
;;;;非同一平面弯头的第二条线：轮廓线
(command "pline")
(command P12)
(command "w")
(command K)
(command K)
(command "a")
(command "a")
(command 180)
(command "c")
(command BCP)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
;;;;非同一平面弯头的第三条线：轮廓线
(command "pline")
(command P13)
(command "w")
(command K)
(command K)
(command P14)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
;;;;非同一平面弯头的第四条线：端线
(command "line")
(command P14)
(command P11)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
;;;;非同一平面弯头的第五条线：轮廓线
(command "pline")
(command P21)
(command "w")
(command K)
(command K)
(command P22)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
;;;;非同一平面弯头的第六条线：端线
(command "line")
(command P22)
(command P23)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command 3)
(command "")
;;;;非同一平面弯头的第七条线：轮廓线
(command "pline")
(command P23)
(command "w")
(command K)
(command K)
(command P24)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
(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:WT
(PRINC)
(PRINC "\n单线管变双线管，起动命令：\"gd\"\n")
(PRINC "\n画上下弯头， 起动命令：\"wt\"\n")
(PRINC)
(defun make-dcl(/ lst_str str file f)
(setq lst_str '(
"pipetest:dialog{"
"label="管道参数设置";"
":edit_box{"
"label="管道外径";"
"key="pipe_dw";"
"edit_width=6;"
"}"
":edit_box{"
"label="弯头弯曲半径";"
"key="pipe_r";"
"edit_width=6;"
"}"
":edit_box{"
"label="弯头直段长度";"
"key="pipe_l";"
"edit_width=6;"
"}"
":edit_box{"
"label="管道轮廓线宽度";"
"key="pipe_w";"
"edit_width=6;"
"}"
": row{: text_part{"
"label=" 管道轮廓线颜色"; key ="pipe_yan";"
"width= 12;"
"fixed_width = true;"
"}: image_button{"
"key ="col";"
"width= 4;"
"aspect_ratio = 0.75;"
"fixed_width = true;"
"}"
": text_part{"
"key ="cnu";"
"width= 12;"
"fixed_width = true;"
"}"
"}"
"ok_only;}"
"bendtest:dialog{"
"label="弯头参数设置";"
":edit_box{"
"label="管道外径";"
"key="bend_dw";"
"edit_width=6;"
"}"
":edit_box{"
"label="弯头弯曲半径";"
"key="bend_r";"
"edit_width=6;"
"}"
":edit_box{"
"label="弯头轮廓线宽度";"
"key="bend_w";"
"edit_width=6;"
"}: row{: text_part{"
"label=" 弯头轮廓线颜色"; key ="bend_yan";"
"width= 12;"
"fixed_width = true;"
"}: image_button{"
"key ="col";"
"width= 4;"
"aspect_ratio = 0.75;"
"fixed_width = true;"
"}"
": text_part{"
"key ="cnu";"
"width= 12;"
"fixed_width = true;"
"}}"
"ok_cancel;"
"}"
)
)
(setq file (vl-filename-mktemp "PIPETEST.dcl"))
(setq f (open file "w"))
(foreach str lst_str
(princ "\n" f)
(princ str f)
)
(close f)
;;返回
file
)
;;;=================================================================*
(princ)
这程序又臭又长。。。
你还不如把要求描述一遍，或者把程序操作演示一遍，重新编个呢。用entmake。 command 可以连续的。
(command "line")
(command P14)
(command P11)
(command "")
可以改成
(command "line" P14 P11 "") 编写/阅读/修改都方便多了。 (command "pline")
(command P23)
(command "w")
(command K)
(command K)
(command P24)
(command "")
(command "chprop")
(command (ENTLAST))
(command "")
(command "c")
(command COL)
(command "")
像这样的语句就是反编译的，是盗版程序
正常人用command不会一句就一个参数
页:
[1]