总图单线管布置插件---

liuhe · 发表于 2023-1-30 17:13:06

本帖最后由 liuhe 于 2023-2-17 08:34 编辑

<blockquote><div class="blockcode"><blockquote>(DEFUN C:Q2 (/ SETVARMODE ODLST CSL2 LAY KEYMODE DN D11 LOOP STR P1 P2
E1 W11 W P3 ANG1 ANG2 XK YS N E1 E2
E3 E4 E5 E6 PP0 PP1 PP11 D11 DN LAY CZ PN XK YS
)
(DEFUN JW(ODLST)
(MAPCAR 'SETVAR
'("cmdecho" "osmode" "peditaccept"
"attdia" "attreq" "dimzin"
"DYNMODE" "shortcutmenu" "autosnap"
)
ODLST
)
(GC)
)
(DEFUN SETVARMODE ()
(MAPCAR 'SETVAR
(LIST "OSMODE" "GRIDMODE" "POLARMODE"
"autosnap" "OrthoMODE" "POLARADDANG"
)
(LIST 16383 0 4 47 0 "45;90;135;180;270")
)
)
(setq ODLST (MAPCAR 'GETVAR
'("cmdecho" "osmode" "peditaccept"
"attdia" "attreq" "dimzin"
"DYNMODE" "shortcutmenu" "autosnap"
)
)
)
(MAPCAR 'SETVAR
'("cmdecho" "peditaccept" "attdia"
"attreq" "dimzin" "DYNMODE"
"shortcutmenu" "gridmode" "autosnap"
)
'(0 1 0 0 8 1 7 0 31 )
)
(SETQ CSL2 (LIST "D11" "LAY" "CZ" "PN" "XK" "YS""N")
LAY (GETVAR 'CLAYER)
KEYMODE "单线管道"
)
(IF (NOT (AND
(VLAX-LDATA-GET "KEYMODE" KEYMODE)
(= (LENGTH (vl-remove 'NIL(VLAX-LDATA-GET "KEYMODE" KEYMODE)))
(LENGTH CSL2)
)
)
)
(PROGN
(VLAX-LDATA-PUT
"KEYMODE"
KEYMODE
(LIST 100 LAY "衬塑钢管" "1.0" 2 256 1)
)
)
)
(MAPCAR (function (lambda (KEY DATA) (set (read key) DATA)))
CSL2
(VLAX-LDATA-GET "KEYMODE" KEYMODE)
)
;;;;;;;;以上通过字典，读取变量
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
(IF (NOT
(SETQ DN (GETREAL (STRCAT "\n请输入管径<" (RTOS D11 2 0) ">: ")))
)
(SETQ DN D11)
(SETQ D11 DN)
)
(SETVARMODE)
(SETQ LOOP T)
(WHILE LOOP
(SETQ STR (STRCAT "管径DN:"
(ITOA (FIX DN))
"; 材质:"
cz
"; PN:"
PN
"Mpa; "
)
)
(setvar "modemacro" (strcat STR))
(INITGET " S SS SSS N NN NNN D DD DDD W WW WWW T TT TTT")
(SETQ
P1 (GETPOINT (STRCASE (STRCAT "起点\n【S:设置】\n【N:设置】\n【W:弯头】\n【T:三通】\n【D:断管】")))
)
(COND
((OR (= P1 "S") (= P1 "SSS") (= P1 "SS"))
(DXGDSZ1)
(MAPCAR (function (lambda (KEY DATA) (set (read key) DATA)))
CSL2
(VLAX-LDATA-GET "KEYMODE" KEYMODE)
)
(SETQ DN D11)
)
((OR (= P1 "N") (= P1 "NN") (= P1 "NNN"))(SETQ N (GETINT (strcat "\n 输入多线数量<" (RTOS 2 2 0) ">"))))
((OR (= P1 "D") (= P1 "DD") (= P1 "DDD"))(DXDG DN YS))
((OR (= P1 "W") (= P1 "WW") (= P1 "WWW"))(WTDG YS LAY))
((OR (= P1 "T") (= P1 "TT") (= P1 "TTT"))(STDG YS LAY))
((= P1 NIL) (progn(JW ODLST) (vl-exit-with-value 0)))
(T
(IF (<= N 0)(SETQ N 1))
(SETQ LROW 200)
(IF (= (CDR (ASSOC 62 (tblsearch "LAYER" LAY))) YS)(SETQ YS 256))
(SETQ P1 (LIST (CAR P1) (CADR P1) 0))
(SETQ P2 (GETPOINT P1 (STRCAT "\n下一点：")))
(IF (= P2 nil)(progn (JW ODLST)(vl-exit-with-value 0)))
(SETQ P2 (LIST (CAR P2) (CADR P2) 0)
I 1
)
(REPEAT N
(SETQ P11 (POLAR P1 (+ (* 0.5 PI) (ANGLE P1 P2)) (* (- I 1) LROW))
P22 (POLAR P2 (+ (* 0.5 PI) (ANGLE P1 P2)) (* (- I 1) LROW))
)
(entmakeX
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 2)
(CONS 62 YS)
(CONS 8 LAY)
(CONS 43 XK)
(cons 10 P11)
(cons 10 P22)
)
)
(SET (READ (STRCAT "E" (RTOS I 2 0))) (ENTLAST))
(SETQ I (1+ i))
)
(WHILE LOOP
(SETVAR "POLARADDANG"
(strcat "45;90;135;180;270;"
(ANGTOS (ANGLE P1 P2) 0)
";"
(ANGTOS (+ (* 0.5 PI) (ANGLE P1 P2)) 0)
";"
(ANGTOS (+ (* 1.5 PI) (ANGLE P1 P2)) 0)
)
)
(SETQ STR (STRCAT "管径DN:"
(ITOA (FIX DN))
"; 材质:"
cz
"; PN:"
PN
"Mpa"
)
)
(setvar "modemacro" (strcat (EVAL STR)))
(IF (NOT W11)
(SETQ W11 1)
)
(IF (NOT (SETQ W
(GETINT
(STRCAT
"\n【1:共线】\n【2:上下弯头】\n【3:下上弯头】\n【11:断管】\n【22:上下弯头】\n【33:下上弯头】\n【默认】 <"
(RTOS W11 2 0)
">: "
)
)
)
)
(SETQ W W11)
(if (member w (list 1 2 3 11 22 33))
(SETQ W11 W)
)
)
(COND
((= W 11) ;;;;;断管
(SETQ I 1)
(REPEAT N
(SETQ ENT (EVAL (READ (STRCAT "E" (RTOS I 2 0))))
PP0 (vlax-curve-getEndPoint ENT)
PP1 (POLAR PP0 (ANGLE P1 P2) 50)
)
(DXDG1 DN YS PP0 PP1)
(SETQ I(1+ I))
)
(progn (JW ODLST) (vl-exit-with-value 0))
)
((= W 22) ;;;;;向下弯头
(SETQ I 1)
(REPEAT N
(SETQ ENT (EVAL (READ (STRCAT "E" (RTOS I 2 0))))
PP0 (vlax-curve-getEndPoint ENT)
PP1 (POLAR PP0 (ANGLE P2 P1) 50)
)
(WTDG1 YS LAY PP0 PP1)
(SETQ I(1+ I))
)
(progn (JW ODLST) (vl-exit-with-value 0))
)
((= W 33) ;;;;;向上弯头
(SETQ I 1)
(REPEAT N
(SETQ ENT (EVAL (READ (STRCAT "E" (RTOS I 2 0))))
PP0 (vlax-curve-getEndPoint ENT)
PP1 (POLAR PP0 (ANGLE P1 P2) 50)
PP2 (POLAR PP1 (ANGLE P1 P2) 50)
)
(WTDG1 YS LAY PP1 PP2)
(SETQ I(1+ I))
)
(progn (JW ODLST) (vl-exit-with-value 0))
)
((= W 1);;;;;;同一个水平面
(SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n"))))
(IF (= P3 NIL)
(progn (JW ODLST) (vl-exit-with-value 0))
)
(SETQ P3 (LIST (CAR P3) (CADR P3) 0)
I 1
LROW -200
)
(SETQ ENTLST (ENTGET E1)
V90 (CDR (ASSOC 90 ENTLST))
ENTLST (vl-remove-if
(function
(LAMBDA (X) (OR (= (CAR X) 210)))
)
ENTLST
)
ENTLST (SUBST (CONS 90 (1+ V90))
(ASSOC 90 ENTLST)
ENTLST
)
LST (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0))
)
(ENTMOD (APPEND ENTLST LST))
(IF (> N 1)
(PROGN
(REPEAT (1- N)
(IF (EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0))))
(PROGN
(SETQ ENTLST (ENTGET
(EVAL
(READ (STRCAT "E" (RTOS (1+ I) 2 0)))
)
)
ENTLST (vl-remove-if-not
(FUNCTION (LAMBDA (X) (= (CAR X) 10)))
ENTLST
)
PP0 (CDR (NTH 0 ENTLST))
)
(ENTDEL
(EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0))))
)
(VLA-OFFSET
(VLAX-ENAME->VLA-OBJECT E1)
(* I LROW)
)
(SETQ ENTLST (ENTGET (ENTLAST))
ENTLST (SUBST (CONS 10 PP0)
(ASSOC 10 ENTLST)
ENTLST
)
)
(ENTMOD ENTLST)
(SET (READ (STRCAT "E" (RTOS (1+ I) 2 0)))
(ENTLAST)
)
)
)
(SETQ I (1+ I))
)
)
)
(SETQ P1 P2
P2 P3
)
)
((= W 2) ;;;;;;执行上下弯头
(SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n"))))
(IF (= P3 NIL)
(progn (JW ODLST) (vl-exit-with-value 0))
)
(SETQ P3 (LIST (CAR P3) (CADR P3) 0)
I 1
LROW -200
)
(SETQ ANG1 (+ (ANGLE P1 P2) (* 0.75 PI))
ANG2 (+ (ANGLE P1 P2) (* 1.25 PI))
)
(SETQ E1LST (ENTGET E1)
E1LST (vl-remove-if
(function
(LAMBDA (X)
(OR (= (CAR X) -1)
(= (CAR X) 330)
(= (CAR X) 5)
(= (CAR X) 410)
)
)
)
E1LST
)
)
(entmakeX E1LST)
(IF (> N 1)
(PROGN
(SETQ ENTLST (ENTGET E1)
V90 (CDR (ASSOC 90 ENTLST))
ENTLST (vl-remove-if
(function
(LAMBDA (X) (= (CAR X) 210))
)
ENTLST
)
ENTLST (SUBST (CONS 90 (1+ V90))
(ASSOC 90 ENTLST)
ENTLST
)
LST (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0))
)
(ENTMOD (APPEND ENTLST LST))
(REPEAT (1- N)
(VLA-OFFSET (VLAX-ENAME->VLA-OBJECT E1) (* I LROW))
(SETQ ENTLST (ENTGET (ENTLAST))
ENTLST (vl-remove-if-not
(FUNCTION (LAMBDA (X) (= (CAR X) 10))
)
ENTLST
)
PP0 (CDR (NTH 0 (REVERSE ENTLST)))
PP1 (CDR (NTH 1 (REVERSE ENTLST)))
PP11 (POLAR PP1 (ANGLE P2 P3) 50)
)
(ENTDEL (ENTLAST))
(SETQ ENTLST (ENTGET
(EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0)))
)
)
ENTLST (SUBST (CONS 10 PP1)
(ASSOC 10 (REVERSE ENTLST))
ENTLST
)
)
(ENTMOD ENTLST)
(entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 PP1)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
(entmakeX
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 2)
(CONS 62 YS)
(CONS 8 LAY)
(CONS 43 XK)
(cons 10 PP11)
(cons 10 PP0)
)
)
(SET (READ (STRCAT "E" (RTOS (1+ I) 2 0)))
(ENTLAST)
)
(SETQ I (1+ I))
)
(ENTDEL E1)
)
)
(SETQ E1 (entmakeX
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 2)
(CONS 62 YS)
(CONS 8 LAY)
(CONS 43 XK)
(cons 10 (POLAR P2 (ANGLE P2 P3) 50))
(cons 10 P3)
)
)
)
(entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 P2)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
(SETQ P1 P2
P2 P3
)
)
((= W 3) ;;;;;执行下上弯头
(SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n"))))
(IF (= P3 NIL)
(progn (JW ODLST) (vl-exit-with-value 0))
)
(SETQ P3 (LIST (CAR P3) (CADR P3) 0)
I 1
LROW -200
)
(SETQ ANG1 (+ (ANGLE P3 P2) (* 0.75 PI))
ANG2 (+ (ANGLE P3 P2) (* 1.25 PI))
)
(SETQ E1LST (ENTGET E1)
E1LST (SUBST (CONS 10 (POLAR P2 (ANGLE P2 P1) 50))
(ASSOC 10 (REVERSE E1LST))
E1LST
)
E1LST (vl-remove-if
(function
(LAMBDA (X)
(OR (= (CAR X) -1)
(= (CAR X) 330)
(= (CAR X) 5)
(= (CAR X) 410)
)
)
)
E1LST
)
)
(entmakeX E1LST)
(IF (> N 1)
(PROGN
(SETQ ENTLST (ENTGET E1)
V90 (CDR (ASSOC 90 ENTLST))
ENTLST (vl-remove-if
(function
(LAMBDA (X) (= (CAR X) 210))
)
ENTLST
)
ENTLST (SUBST (CONS 90 (1+ V90))
(ASSOC 90 ENTLST)
ENTLST
)
LST (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0))
)
(ENTMOD (APPEND ENTLST LST))
(REPEAT (1- N)
(VLA-OFFSET (VLAX-ENAME->VLA-OBJECT E1) (* I LROW))
(SETQ ENTLST (ENTGET (ENTLAST))
ENTLST (vl-remove-if-not
(FUNCTION (LAMBDA (X) (= (CAR X) 10))
)
ENTLST
)
PP0 (CDR (NTH 0 (REVERSE ENTLST)))
PP1 (CDR (NTH 1 (REVERSE ENTLST)))
PP11 (POLAR PP1 (ANGLE P2 P1) 50)
)
(ENTDEL (ENTLAST))
(SETQ ENTLST (ENTGET
(EVAL
(READ (STRCAT "E" (RTOS (1+ I) 2 0)))
)
)
ENTLST (SUBST (CONS 10 PP11)
(ASSOC 10 (REVERSE ENTLST))
ENTLST
)
)
(ENTMOD ENTLST)
(entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 PP1)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
(entmakeX
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 2)
(CONS 62 YS)
(CONS 8 LAY)
(CONS 43 XK)
(cons 10 PP1)
(cons 10 PP0)
)
)
(SET (READ (STRCAT "E" (RTOS (1+ I) 2 0)))
(ENTLAST)
)
(SETQ I (1+ I))
)
)
)
(ENTDEL E1)
(SETQ E1 (entmakeX
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 2)
(CONS 62 YS)
(CONS 8 LAY)
(CONS 43 XK)
(cons 10 P2)
(cons 10 P3)
)
)
)
(entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 P2)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
(SETQ P1 P2
P2 P3
)
)
)
)
)
)
)
)
(defun MID (po1 po2)
(setq po (MAPCAR '(lambda (X Y) (* (+ X Y) 0.5)) po1 po2))
)
(DEFUN ARC3(P1 P2 P3 / PT R ANG1 ANG2 E1 E2 E3 );;;;;;三点画弧
(SETVAR "cmdecho" 0)
(IF (AND (> (DISTANCE P1 P2) (DISTANCE P1 P3))
(> (DISTANCE P1 P2) (DISTANCE P2 P3))
)
(SETQ PT P1
P1 P3
P3 PT
)
)
(SETQ PT (INTERS (POLAR (MID P1 P2)
(+ (* 0.5 PI) (ANGLE P1 P2))
(DISTANCE P1 P2)
)
(MID P1 P2)
(POLAR (MID P3 P2)
(+ (* 0.5 PI) (ANGLE P3 P2))
(DISTANCE P3 P2)
)
(MID P2 P3)
NIL
)
R (DISTANCE PT P1)
ANG1 (ANGLE PT P1)
ANG2 (ANGLE PT P3)
E1 (ENTMAKEX (LIST '(0 . "ARC")
(CONS 10 PT)
(CONS 40 R)
(CONS 50 ANG1)
(CONS 51 ANG2)
)
)
E2 (ENTMAKEX (LIST '(0 . "ARC")
(CONS 10 PT)
(CONS 40 R)
(CONS 50 ANG2)
(CONS 51 ANG1)
)
)
E3 (ENTMAKEX (LIST '(0 . "LINE")
(CONS 10 PT)
(CONS 11 (POLAR P2 (ANGLE PT P2) R))
)
)
)
(IF (> (vlax-safearray-get-u-bound
(vlax-variant-value
(vla-intersectwith
(vlax-ename->vla-object e1)
(vlax-ename->vla-object e3)
acExtendNonE
)
)
1
)
0
)
(PROGN (ENTDEL E2) (ENTDEL E3) E1)
(PROGN (ENTDEL E1) (ENTDEL E3) E2)
)
)
(defun DXDG ( DN YS / PX PY)
(SETVAR "OSMODE" 0)
(setvar "cmdecho" 0)
(SETQ PX (GETPOINT "\n断管插入点"))
(IF (= PX NIL)(progn (vl-exit-with-value 0)))
(SETQ PY (GETPOINT PX (STRCAT "\n断管方向")))
(IF (= PY NIL)(progn (vl-exit-with-value 0)))
(DXDG1 DN YS PX PY)
)
(DEFUN DXDG1 (DN YS PX PY / P1 P2 P3 P3_1 E1 E2)
(vl-load-com)
(SETQ P1(POLAR PX(+ (ANGLE PX PY) (* 0.5 PI)) (* 0.5 DN))
P2(POLAR PX(+ (ANGLE PX PY) (* 1.5 PI)) (* 0.5 DN)))
(SETQ P3 (MID P1 P2))
(SETQ P3_1 (POLAR (MID P1 P3) (- (ANGLE P1 P2) (* 0.5 PI)) (* 0.1 DN)))
(ARC3 P1 P3_1 P3)
(SETQ E1 (ENTLAST))
(vla-PUt-Color (vlax-ename->vla-object E1)YS)
(setq E2 (vla-copy(vlax-ename->vla-object E1)))
(vla-Rotate E2 (vlax-3D-point PX)PI)
(VL-CMDF "GROUP" "C" "*" "*"E1 (vlax-vla-object->ename E2) "")
(PRINC)
)
(DEFUN WTDG ( YS LAY / PX PY )
(SETQ PX (GETPOINT "\n弯头插入点"))
(IF (= PX NIL)(progn (vl-exit-with-value 0)))
(SETQ PY (GETPOINT PX (STRCAT "\n高管方向")))
(IF (= PY NIL)(progn (vl-exit-with-value 0)))
(WTDG1 YS LAY PX PY)
)
(DEFUN WTDG1 ( YS LAY PX PY / ANG1 ANG2)
(SETQ ANG1 (+ (ANGLE PY PX) (* 0.75 PI))
ANG2 (+ (ANGLE PY PX) (* 1.25 PI))
)
(entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 PX)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
)
(DEFUN STDG ( YS LAY / PX PY ANG1 ANG2 ANG3 ANG4 E1 E2)
(SETQ PX (GETPOINT "\n弯头插入点"))
(IF (= PX NIL)(progn (vl-exit-with-value 0)))
(SETQ PY (GETPOINT PX (STRCAT "\n高管方向")))
(IF (= PY NIL)(progn (vl-exit-with-value 0)))
(SETQ ANG1 (+ (ANGLE PY PX) (* 0.75 PI))
ANG2 (+ (ANGLE PY PX) (* 0.25 PI))
ANG3 (+ (ANGLE PY PX) (* 1.75 PI))
ANG4 (+ (ANGLE PY PX) (* 1.25 PI))
)
(SETQ E1 (entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 PX)
(cons 40 50)
(cons 50 ang2)
(cons 51 ang1)
)
)
E2 (entmakeX (list '(0 . "ARC")
(CONS 62 YS)
(CONS 8 LAY)
(cons 10 PX)
(cons 40 50)
(cons 50 ang4)
(cons 51 ang3)
)
)
)
(VL-CMDF "GROUP" "C" "*" "*"E1 E2 "")
)
(DEFUN DXGDSZ1 (/ LPN DNLST LAY1 LAYS LAYL DCL_ID STD COLOR DN LAY CZ PN XK YS KEYMODE N)
(IF (NULL VLAX-DUMP-OBJECT)
(VL-LOAD-COM)
)
(SETQ LPN (LIST "0.25" "0.6" "1.0" "1.6" "2.5"
"4.0" "6.3" "10.0" "16.0" "25.0"
"40.0"
)
DNLST (MAPCAR '(lambda (x) (RTOS X 2 0))
(LIST 15 20 25 32 40 50 65 80
90 100 125 150 200 250 300 350
400 450 500 550 600 650 700 750
800 850 900 950 1000 1100 1200
)
)
)
(setq lays (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
LAYL NIL
KEYMODE "单线管道"
)
(MAPCAR (function (lambda (KEY DATA) (set (read key) DATA)))
(LIST "DN" "LAY" "CZ" "PN" "XK" "YS""N")
(VLAX-LDATA-GET "KEYMODE" KEYMODE)
)
(VLAX-FOR LAY LAYS
(SETQ LAYL (CONS (VLA-GET-NAME LAY) LAYL))
)
(setq LAY1 (REVERSE LAYL))
;;; (setq dcl_id (load_dialog (make-dclgd)))
(setq dcl_id
(load_dialog
"E:\\维尔利工作-2022\\CAD模版\\cad坐标插件\\LY插件缓存文件\\单线管道绘制.DCL"
)
)
(if (< dcl_id 0)
(vl-exit-with-value 0)
)
(setq std 2)
(while (> std 1)
(new_dialog "DXGD" dcl_id)
(START_LIST "YL1")
(MAPCAR 'ADD_LIST LPN)
(END_LIST)
(START_LIST "DN1")
(MAPCAR 'ADD_LIST DNLST)
(END_LIST)
(START_LIST "LAY1")
(MAPCAR 'ADD_LIST LAY1)
(END_LIST)
(set_tile "CZ1" CZ)
(set_tile "N1" (RTOS N 2 0))
(set_tile "XK1" (RTOS XK 2 0))
(set_tile "YS1" (RTOS YS 2 0))
(set_tile "YL1" (RTOS (vl-position PN LPN) 2 0))
(set_tile "DN1"(RTOS (vl-position (RTOS DN 2 0) DNLST) 2 0))
(set_tile "LAY1" (RTOS (vl-position LAY LAY1) 2 0))
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" "(DXGDSZ2 LPN DNLST LAY1)(done_dialog 1) ")
(action_tile "XYS" "(DXGDSZ3) ")
(setq STD (start_dialog))
(unload_dialog dcl_id)
)
)
(DEFUN DXGDSZ3 ( / COLOR)
(setq color (acad_colordlg 3))
(IF color
(set_tile "YS1" (RTOS COLOR 2 0))
)
)
(DEFUN DXGDSZ2 ( LPN DNLST LAY1 / D11 LAY CZ PN XK YS KEYMODE N)
(SETQ CZ (get_tile "CZ1"))
(SETQ PN (nth (atoi (Get_tile "YL1")) LPN))
(SETQ DN (ATOI (nth (atoi (Get_tile "DN1")) DNLST)))
(SETQ LAY (nth (atoi (Get_tile "LAY1")) LAY1))
(SETQ XK (ATOI (get_tile "XK1")))
(SETQ N (ATOI (get_tile "N1")))
(SETQ YS (ATOI (get_tile "YS1"))
KEYMODE "单线管道")
(VLAX-LDATA-PUT "KEYMODE" KEYMODE(LIST DN LAY CZ PN XK YS N) )
)

<blockquote><div class="blockcode"><blockquote>(DEFUN C:Q2 (/  SETVARMODE  ODLST  CSL2 LAY  KEYMODE   DN   D11  LOOP STR  P1   P2 
       E1    W11  W    P3   ANG1 ANG2 XK  YS   N    E1   E2 
       E3    E4   E5   E6   PP0   PP1    PP11 D11 DN LAY CZ PN XK YS 
      ) 
  (DEFUN JW(ODLST) 
  (MAPCAR 'SETVAR 
         '("cmdecho"  "osmode"       "peditaccept" 
     "attdia"  "attreq"       "dimzin" 
     "DYNMODE"  "shortcutmenu" "autosnap" 
    ) 
         ODLST 
       ) 
    (GC) 
  ) 
  (DEFUN SETVARMODE () 
    (MAPCAR 'SETVAR 
      (LIST "OSMODE"    "GRIDMODE"    "POLARMODE" 
      "autosnap"    "OrthoMODE"    "POLARADDANG" 
     ) 
      (LIST 16383 0 4 47 0 "45;90;135;180;270") 
    ) 
  ) 
  (setq  ODLST (MAPCAR 'GETVAR 
     '("cmdecho"    "osmode"   "peditaccept" 
       "attdia"    "attreq"   "dimzin" 
       "DYNMODE"    "shortcutmenu" "autosnap" 
      ) 
   ) 
  ) 
  (MAPCAR 'SETVAR 
    '("cmdecho"      "peditaccept"   "attdia" 
      "attreq"      "dimzin"      "DYNMODE" 
      "shortcutmenu"  "gridmode"      "autosnap" 
     ) 
    '(0 1 0 0 8 1 7 0 31 ) 
  ) 
   
  (SETQ  CSL2  (LIST "D11" "LAY" "CZ" "PN" "XK" "YS""N") 
  LAY  (GETVAR 'CLAYER) 
  KEYMODE  "单线管道" 
  ) 
  (IF (NOT (AND 
       (VLAX-LDATA-GET "KEYMODE" KEYMODE) 
       (=  (LENGTH (vl-remove 'NIL(VLAX-LDATA-GET "KEYMODE" KEYMODE))) 
    (LENGTH CSL2) 
       ) 
     ) 
      ) 
    (PROGN 
      (VLAX-LDATA-PUT 
  "KEYMODE" 
  KEYMODE 
  (LIST 100 LAY "衬塑钢管" "1.0" 2 256 1) 
      ) 
    ) 
  ) 
  (MAPCAR (function (lambda (KEY DATA) (set (read key) DATA))) 
    CSL2 
    (VLAX-LDATA-GET "KEYMODE" KEYMODE) 
  ) 
;;;;;;;;以上通过字典，读取变量 
;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
  (IF (NOT 
  (SETQ DN (GETREAL (STRCAT "\n请输入管径<" (RTOS D11 2 0) ">: "))) 
      ) 
    (SETQ DN D11) 
    (SETQ D11 DN) 
  ) 
  (SETVARMODE) 
  (SETQ LOOP T) 
  (WHILE LOOP 
    (SETQ STR (STRCAT "管径DN:" 
          (ITOA (FIX DN)) 
          "; 材质:" 
          cz 
          "; PN:" 
          PN 
          "Mpa; " 
        ) 
    ) 
    (setvar "modemacro" (strcat STR)) 
    (INITGET " S SS SSS N NN NNN D DD DDD W WW WWW T TT TTT") 
    (SETQ 
      P1 (GETPOINT (STRCASE (STRCAT "起点\n【S:设置】\n【N:设置】\n【W:弯头】\n【T:三通】\n【D:断管】"))) 
    ) 
    (COND 
      ((OR (= P1 "S") (= P1 "SSS") (= P1 "SS")) 
  (DXGDSZ1) 
  (MAPCAR  (function (lambda (KEY DATA) (set (read key) DATA))) 
    CSL2 
    (VLAX-LDATA-GET "KEYMODE" KEYMODE) 
  ) 
  (SETQ DN D11) 
      ) 
      ((OR (= P1 "N") (= P1 "NN") (= P1 "NNN"))(SETQ N (GETINT (strcat "\n 输入多线数量<" (RTOS 2 2 0) ">")))) 
      ((OR (= P1 "D") (= P1 "DD") (= P1 "DDD"))(DXDG DN YS)) 
      ((OR (= P1 "W") (= P1 "WW") (= P1 "WWW"))(WTDG YS LAY)) 
      ((OR (= P1 "T") (= P1 "TT") (= P1 "TTT"))(STDG YS LAY)) 
      ((= P1 NIL) (progn(JW ODLST) (vl-exit-with-value 0))) 
      (T 
       (IF (<= N 0)(SETQ N 1)) 
       (SETQ LROW 200) 
       (IF (= (CDR (ASSOC 62 (tblsearch "LAYER" LAY))) YS)(SETQ YS 256)) 
       (SETQ P1 (LIST (CAR P1) (CADR P1) 0)) 
       (SETQ P2 (GETPOINT P1 (STRCAT "\n下一点："))) 
       (IF (= P2 nil)(progn (JW ODLST)(vl-exit-with-value 0))) 
       (SETQ P2  (LIST (CAR P2) (CADR P2) 0) 
       I  1 
       ) 
       (REPEAT N 
   (SETQ P11 (POLAR P1 (+ (* 0.5 PI) (ANGLE P1 P2)) (* (- I 1) LROW)) 
         P22 (POLAR P2 (+ (* 0.5 PI) (ANGLE P1 P2)) (* (- I 1) LROW)) 
   ) 
   (entmakeX 
     (list '(0 . "LWPOLYLINE") 
     '(100 . "AcDbEntity") 
     '(100 . "AcDbPolyline") 
     (cons 90 2) 
     (CONS 62 YS) 
     (CONS 8 LAY) 
     (CONS 43 XK) 
     (cons 10 P11) 
     (cons 10 P22) 
     ) 
   ) 
   (SET (READ (STRCAT "E" (RTOS I 2 0))) (ENTLAST)) 
   (SETQ I (1+ i)) 
       ) 
       (WHILE LOOP 
   (SETVAR "POLARADDANG" 
     (strcat "45;90;135;180;270;" 
       (ANGTOS (ANGLE P1 P2) 0) 
       ";" 
       (ANGTOS (+ (* 0.5 PI) (ANGLE P1 P2)) 0) 
       ";" 
       (ANGTOS (+ (* 1.5 PI) (ANGLE P1 P2)) 0) 
     ) 
   ) 
   (SETQ STR (STRCAT "管径DN:" 
         (ITOA (FIX DN)) 
         "; 材质:" 
         cz 
         "; PN:" 
         PN 
         "Mpa" 
       ) 
   ) 
   (setvar "modemacro" (strcat (EVAL STR))) 
   (IF (NOT W11) 
     (SETQ W11 1) 
   ) 
   (IF (NOT (SETQ  W 
       (GETINT 
         (STRCAT 
           "\n【1:共线】\n【2:上下弯头】\n【3:下上弯头】\n【11:断管】\n【22:上下弯头】\n【33:下上弯头】\n【默认】 <" 
           (RTOS W11 2 0) 
           ">: " 
         ) 
       ) 
      ) 
       ) 
     (SETQ W W11) 
     (if (member w (list 1 2 3 11 22 33)) 
       (SETQ W11 W) 
     ) 
   ) 
   (COND 
     ((= W 11) ;;;;;断管 
      (SETQ I 1) 
      (REPEAT N 
        (SETQ ENT  (EVAL (READ (STRCAT "E" (RTOS I 2 0)))) 
        PP0  (vlax-curve-getEndPoint ENT) 
        PP1  (POLAR PP0 (ANGLE P1 P2) 50) 
        ) 
        (DXDG1 DN YS PP0 PP1) 
        (SETQ I(1+ I)) 
        ) 
      (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
     ((= W 22) ;;;;;向下弯头 
      (SETQ I 1) 
      (REPEAT N 
        (SETQ ENT  (EVAL (READ (STRCAT "E" (RTOS I 2 0)))) 
        PP0  (vlax-curve-getEndPoint ENT) 
        PP1  (POLAR PP0 (ANGLE P2 P1) 50) 
        ) 
        (WTDG1 YS LAY  PP0 PP1) 
        (SETQ I(1+ I)) 
        ) 
      (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
     ((= W 33) ;;;;;向上弯头 
      (SETQ I 1) 
      (REPEAT N 
        (SETQ ENT  (EVAL (READ (STRCAT "E" (RTOS I 2 0)))) 
        PP0  (vlax-curve-getEndPoint ENT) 
        PP1  (POLAR PP0 (ANGLE P1 P2) 50) 
        PP2  (POLAR PP1 (ANGLE P1 P2) 50) 
         
        ) 
        (WTDG1 YS LAY PP1 PP2) 
        (SETQ I(1+ I)) 
        ) 
      (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
     ((= W 1);;;;;;同一个水平面 
      (SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n")))) 
      (IF  (= P3 NIL) 
        (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
      (SETQ P3   (LIST (CAR P3) (CADR P3) 0) 
      I    1 
      LROW -200 
      ) 
      (SETQ ENTLST (ENTGET E1) 
      V90   (CDR (ASSOC 90 ENTLST)) 
      ENTLST (vl-remove-if 
         (function 
           (LAMBDA (X) (OR (= (CAR X) 210))) 
         ) 
         ENTLST 
       ) 
      ENTLST (SUBST  (CONS 90 (1+ V90)) 
        (ASSOC 90 ENTLST) 
        ENTLST 
       ) 
      LST   (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0)) 
      ) 
      (ENTMOD (APPEND ENTLST LST)) 
      (IF  (> N 1) 
        (PROGN 
    (REPEAT  (1- N) 
      (IF (EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0)))) 
        (PROGN 
          (SETQ ENTLST (ENTGET 
             (EVAL 
               (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
             ) 
           ) 
          ENTLST (vl-remove-if-not 
             (FUNCTION (LAMBDA (X) (= (CAR X) 10))) 
             ENTLST 
           ) 
          PP0     (CDR (NTH 0 ENTLST)) 
          ) 
          (ENTDEL 
      (EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0)))) 
          ) 
          (VLA-OFFSET 
      (VLAX-ENAME->VLA-OBJECT E1) 
      (* I LROW) 
          ) 
          (SETQ ENTLST (ENTGET (ENTLAST)) 
          ENTLST (SUBST (CONS 10 PP0) 
            (ASSOC 10 ENTLST) 
            ENTLST 
           ) 
 
          ) 
          (ENTMOD ENTLST) 
          (SET (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
         (ENTLAST) 
          )    
        ) 
      ) 
      (SETQ I (1+ I)) 
    ) 
        ) 
      ) 
      (SETQ P1 P2 
      P2 P3 
      ) 
     ) 
     ((= W 2)            ;;;;;;执行上下弯头 
      (SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n")))) 
      (IF  (= P3 NIL) 
        (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
      (SETQ P3   (LIST (CAR P3) (CADR P3) 0) 
      I    1 
      LROW -200 
      ) 
      (SETQ ANG1 (+ (ANGLE P1 P2) (* 0.75 PI)) 
      ANG2 (+ (ANGLE P1 P2) (* 1.25 PI)) 
      ) 
      (SETQ E1LST  (ENTGET E1) 
      E1LST  (vl-remove-if 
        (function 
          (LAMBDA (X) 
            (OR (= (CAR X) -1) 
          (= (CAR X) 330) 
          (= (CAR X) 5) 
          (= (CAR X) 410) 
            ) 
          ) 
        ) 
        E1LST 
      ) 
      ) 
      (entmakeX E1LST) 
      (IF  (> N 1) 
        (PROGN 
    (SETQ ENTLST (ENTGET E1) 
          V90    (CDR (ASSOC 90 ENTLST)) 
          ENTLST (vl-remove-if 
             (function 
         (LAMBDA (X) (= (CAR X) 210)) 
             ) 
             ENTLST 
           ) 
          ENTLST (SUBST (CONS 90 (1+ V90)) 
            (ASSOC 90 ENTLST) 
            ENTLST 
           ) 
          LST    (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0)) 
    ) 
    (ENTMOD (APPEND ENTLST LST)) 
    (REPEAT  (1- N) 
      (VLA-OFFSET (VLAX-ENAME->VLA-OBJECT E1) (* I LROW)) 
      (SETQ  ENTLST (ENTGET (ENTLAST)) 
      ENTLST (vl-remove-if-not 
         (FUNCTION (LAMBDA (X) (= (CAR X) 10)) 
         ) 
         ENTLST 
             ) 
      PP0    (CDR (NTH 0 (REVERSE ENTLST))) 
      PP1    (CDR (NTH 1 (REVERSE ENTLST))) 
      PP11   (POLAR PP1 (ANGLE P2 P3) 50) 
      ) 
      (ENTDEL (ENTLAST)) 
      (SETQ  ENTLST (ENTGET 
         (EVAL (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
         ) 
             ) 
      ENTLST (SUBST (CONS 10 PP1) 
              (ASSOC 10 (REVERSE ENTLST)) 
              ENTLST 
             ) 
      ) 
      (ENTMOD ENTLST) 
      (entmakeX (list '(0 . "ARC") 
          (CONS 62 YS) 
          (CONS 8 LAY) 
          (cons 10 PP1) 
          (cons 40 50) 
          (cons 50 ang2) 
          (cons 51 ang1) 
          ) 
      ) 
      (entmakeX 
        (list '(0 . "LWPOLYLINE") 
        '(100 . "AcDbEntity") 
        '(100 . "AcDbPolyline") 
        (cons 90 2) 
        (CONS 62 YS) 
        (CONS 8 LAY) 
        (CONS 43 XK) 
        (cons 10 PP11) 
        (cons 10 PP0) 
        ) 
      ) 
      (SET (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
           (ENTLAST) 
      ) 
      (SETQ I (1+ I)) 
    ) 
    (ENTDEL E1) 
        ) 
      ) 
      (SETQ E1 (entmakeX 
           (list '(0 . "LWPOLYLINE") 
           '(100 . "AcDbEntity") 
           '(100 . "AcDbPolyline") 
           (cons 90 2) 
           (CONS 62 YS) 
           (CONS 8 LAY) 
           (CONS 43 XK) 
           (cons 10 (POLAR P2 (ANGLE P2 P3) 50)) 
           (cons 10 P3) 
           ) 
         ) 
      ) 
      (entmakeX (list '(0 . "ARC") 
          (CONS 62 YS) 
          (CONS 8 LAY) 
          (cons 10 P2) 
          (cons 40 50) 
          (cons 50 ang2) 
          (cons 51 ang1) 
          ) 
      ) 
 
      (SETQ P1 P2 
      P2 P3 
      ) 
     ) 
     ((= W 3)             ;;;;;执行下上弯头 
      (SETQ P3 (GETPOINT P2 (STRCASE (STRCAT "下一点\n")))) 
      (IF  (= P3 NIL) 
        (progn (JW ODLST) (vl-exit-with-value 0)) 
      ) 
      (SETQ P3   (LIST (CAR P3) (CADR P3) 0) 
      I    1 
      LROW -200 
      ) 
      (SETQ ANG1 (+ (ANGLE P3 P2) (* 0.75 PI)) 
      ANG2 (+ (ANGLE P3 P2) (* 1.25 PI)) 
      ) 
      (SETQ E1LST  (ENTGET E1) 
      E1LST  (SUBST (CONS 10 (POLAR P2 (ANGLE P2 P1) 50)) 
             (ASSOC 10 (REVERSE E1LST)) 
             E1LST 
      ) 
      E1LST  (vl-remove-if 
        (function 
          (LAMBDA (X) 
            (OR (= (CAR X) -1) 
          (= (CAR X) 330) 
          (= (CAR X) 5) 
          (= (CAR X) 410) 
            ) 
          ) 
        ) 
        E1LST 
      ) 
      ) 
      (entmakeX E1LST) 
      (IF  (> N 1) 
        (PROGN 
    (SETQ ENTLST (ENTGET E1) 
          V90    (CDR (ASSOC 90 ENTLST)) 
          ENTLST (vl-remove-if 
             (function 
         (LAMBDA (X) (= (CAR X) 210)) 
             ) 
             ENTLST 
           ) 
          ENTLST (SUBST (CONS 90 (1+ V90)) 
            (ASSOC 90 ENTLST) 
            ENTLST 
           ) 
          LST    (LIST (CONS 10 P3) (LIST 210 0.0 0.0 1.0)) 
    ) 
    (ENTMOD (APPEND ENTLST LST)) 
    (REPEAT  (1- N) 
      (VLA-OFFSET (VLAX-ENAME->VLA-OBJECT E1) (* I LROW)) 
      (SETQ  ENTLST (ENTGET (ENTLAST)) 
      ENTLST (vl-remove-if-not 
         (FUNCTION (LAMBDA (X) (= (CAR X) 10)) 
         ) 
         ENTLST 
             ) 
      PP0    (CDR (NTH 0 (REVERSE ENTLST))) 
      PP1    (CDR (NTH 1 (REVERSE ENTLST))) 
      PP11   (POLAR PP1 (ANGLE P2 P1) 50) 
      ) 
      (ENTDEL (ENTLAST)) 
      (SETQ  ENTLST (ENTGET 
         (EVAL 
           (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
         ) 
             ) 
      ENTLST (SUBST (CONS 10 PP11) 
              (ASSOC 10 (REVERSE ENTLST)) 
              ENTLST 
             ) 
      ) 
      (ENTMOD ENTLST) 
      (entmakeX (list '(0 . "ARC") 
          (CONS 62 YS) 
          (CONS 8 LAY) 
          (cons 10 PP1) 
          (cons 40 50) 
          (cons 50 ang2) 
          (cons 51 ang1) 
          ) 
      ) 
      (entmakeX 
        (list '(0 . "LWPOLYLINE") 
        '(100 . "AcDbEntity") 
        '(100 . "AcDbPolyline") 
        (cons 90 2) 
        (CONS 62 YS) 
        (CONS 8 LAY) 
        (CONS 43 XK) 
        (cons 10 PP1) 
        (cons 10 PP0) 
        ) 
      ) 
      (SET (READ (STRCAT "E" (RTOS (1+ I) 2 0))) 
           (ENTLAST) 
      ) 
      (SETQ I (1+ I)) 
    ) 
 
        ) 
      ) 
      (ENTDEL E1) 
      (SETQ E1 (entmakeX 
           (list '(0 . "LWPOLYLINE") 
           '(100 . "AcDbEntity") 
           '(100 . "AcDbPolyline") 
           (cons 90 2) 
           (CONS 62 YS) 
           (CONS 8 LAY) 
           (CONS 43 XK) 
           (cons 10 P2) 
           (cons 10 P3) 
           ) 
         ) 
      ) 
      (entmakeX (list '(0 . "ARC") 
          (CONS 62 YS) 
          (CONS 8 LAY) 
          (cons 10 P2) 
          (cons 40 50) 
          (cons 50 ang2) 
          (cons 51 ang1) 
          ) 
      ) 
      (SETQ P1 P2 
      P2 P3 
      ) 
     ) 
   ) 
       ) 
      ) 
    ) 
  ) 
) 
(defun MID (po1 po2) 
    (setq po (MAPCAR '(lambda (X Y) (* (+ X Y) 0.5)) po1 po2)) 
  ) 
(DEFUN ARC3(P1 P2 P3 /  PT R ANG1 ANG2 E1 E2 E3 );;;;;;三点画弧 
  (SETVAR "cmdecho" 0) 
  (IF (AND (> (DISTANCE P1 P2) (DISTANCE P1 P3)) 
     (> (DISTANCE P1 P2) (DISTANCE P2 P3)) 
      ) 
    (SETQ PT P1 
    P1 P3 
    P3 PT 
    ) 
  )   
  (SETQ  PT   (INTERS (POLAR (MID P1 P2) 
          (+ (* 0.5 PI) (ANGLE P1 P2)) 
          (DISTANCE P1 P2) 
         ) 
         (MID P1 P2) 
         (POLAR (MID P3 P2) 
          (+ (* 0.5 PI) (ANGLE P3 P2)) 
          (DISTANCE P3 P2) 
         ) 
         (MID P2 P3) 
         NIL 
       ) 
  R    (DISTANCE PT P1) 
  ANG1 (ANGLE PT P1) 
  ANG2 (ANGLE PT P3) 
  E1   (ENTMAKEX (LIST '(0 . "ARC") 
           (CONS 10 PT) 
           (CONS 40 R) 
           (CONS 50 ANG1) 
           (CONS 51 ANG2) 
           ) 
       ) 
  E2   (ENTMAKEX (LIST '(0 . "ARC") 
           (CONS 10 PT) 
           (CONS 40 R) 
           (CONS 50 ANG2) 
           (CONS 51 ANG1) 
           ) 
       ) 
  E3   (ENTMAKEX (LIST '(0 . "LINE") 
           (CONS 10 PT) 
           (CONS 11 (POLAR P2 (ANGLE PT P2) R)) 
           ) 
       ) 
  ) 
  (IF (> (vlax-safearray-get-u-bound 
     (vlax-variant-value 
       (vla-intersectwith 
         (vlax-ename->vla-object e1) 
         (vlax-ename->vla-object e3) 
         acExtendNonE 
       ) 
     ) 
     1 
   ) 
   0 
      ) 
    (PROGN (ENTDEL E2) (ENTDEL E3) E1) 
    (PROGN (ENTDEL E1) (ENTDEL E3) E2) 
  ) 
  ) 
 (defun  DXDG ( DN YS / PX PY) 
   (SETVAR "OSMODE" 0) 
   (setvar "cmdecho" 0) 
   (SETQ PX (GETPOINT "\n断管插入点")) 
   (IF (= PX NIL)(progn (vl-exit-with-value 0))) 
   (SETQ PY (GETPOINT PX (STRCAT "\n断管方向"))) 
   (IF (= PY NIL)(progn (vl-exit-with-value 0))) 
   (DXDG1 DN YS PX PY) 
 ) 
(DEFUN DXDG1 (DN YS PX PY /  P1 P2 P3 P3_1   E1 E2) 
  (vl-load-com) 
  (SETQ P1(POLAR PX(+ (ANGLE PX PY) (* 0.5 PI)) (* 0.5 DN)) 
  P2(POLAR PX(+ (ANGLE PX PY) (* 1.5 PI)) (* 0.5 DN))) 
  (SETQ P3 (MID P1 P2)) 
  (SETQ P3_1 (POLAR (MID P1 P3) (- (ANGLE P1 P2) (* 0.5 PI)) (* 0.1 DN))) 
  (ARC3 P1 P3_1 P3) 
  (SETQ E1 (ENTLAST)) 
  (vla-PUt-Color (vlax-ename->vla-object E1)YS) 
  (setq E2 (vla-copy(vlax-ename->vla-object E1))) 
  (vla-Rotate  E2 (vlax-3D-point PX)PI) 
  (VL-CMDF "GROUP" "C" "*" "*"E1 (vlax-vla-object->ename E2) "") 
  (PRINC) 
) 
 
 
(DEFUN WTDG ( YS LAY / PX PY ) 
  (SETQ PX (GETPOINT "\n弯头插入点")) 
  (IF (= PX NIL)(progn (vl-exit-with-value 0))) 
  (SETQ PY (GETPOINT PX (STRCAT "\n高管方向"))) 
  (IF (= PY NIL)(progn (vl-exit-with-value 0))) 
  (WTDG1 YS LAY PX PY) 
) 
(DEFUN WTDG1 ( YS LAY  PX PY / ANG1 ANG2) 
  (SETQ  ANG1 (+ (ANGLE PY PX) (* 0.75 PI)) 
  ANG2 (+ (ANGLE PY PX) (* 1.25 PI)) 
  ) 
  (entmakeX (list '(0 . "ARC") 
      (CONS 62 YS) 
      (CONS 8 LAY) 
      (cons 10 PX) 
      (cons 40 50) 
      (cons 50 ang2) 
      (cons 51 ang1) 
      ) 
  ) 
) 
 
 
 
(DEFUN STDG ( YS LAY / PX PY ANG1 ANG2 ANG3 ANG4 E1 E2) 
  (SETQ PX (GETPOINT "\n弯头插入点")) 
  (IF (= PX NIL)(progn (vl-exit-with-value 0))) 
  (SETQ PY (GETPOINT PX (STRCAT "\n高管方向"))) 
  (IF (= PY NIL)(progn (vl-exit-with-value 0))) 
  (SETQ  ANG1 (+ (ANGLE PY PX) (* 0.75 PI)) 
  ANG2 (+ (ANGLE PY PX) (* 0.25 PI)) 
  ANG3 (+ (ANGLE PY PX) (* 1.75 PI)) 
  ANG4 (+ (ANGLE PY PX) (* 1.25 PI)) 
   
  ) 
  (SETQ  E1 (entmakeX (list '(0 . "ARC") 
         (CONS 62 YS) 
         (CONS 8 LAY) 
         (cons 10 PX) 
         (cons 40 50) 
         (cons 50 ang2) 
         (cons 51 ang1) 
         ) 
     ) 
  E2 (entmakeX (list '(0 . "ARC") 
         (CONS 62 YS) 
         (CONS 8 LAY) 
         (cons 10 PX) 
         (cons 40 50) 
         (cons 50 ang4) 
         (cons 51 ang3) 
         ) 
     ) 
  ) 
  (VL-CMDF "GROUP" "C" "*" "*"E1 E2 "") 
) 
 
(DEFUN DXGDSZ1 (/ LPN DNLST LAY1 LAYS LAYL DCL_ID STD COLOR DN LAY CZ PN XK YS KEYMODE N) 
  (IF (NULL VLAX-DUMP-OBJECT) 
    (VL-LOAD-COM) 
  ) 
  (SETQ  LPN   (LIST "0.25"   "0.6"    "1.0"    "1.6"  "2.5" 
        "4.0"    "6.3"    "10.0"   "16.0"  "25.0" 
        "40.0" 
       ) 
  DNLST (MAPCAR '(lambda (x) (RTOS X 2 0)) 
          (LIST 15   20   25   32  40   50    65   80 
          90   100  125  150  200  250  300  350 
          400   450  500  550  600  650  700  750 
          800   850  900  950  1000 1100 1200 
         ) 
        ) 
  ) 
  (setq  lays (vla-get-layers 
         (vla-get-activedocument (vlax-get-acad-object)) 
       ) 
  LAYL NIL 
  KEYMODE  "单线管道" 
  ) 
  (MAPCAR (function (lambda (KEY DATA) (set (read key) DATA))) 
    (LIST "DN" "LAY" "CZ" "PN" "XK" "YS""N") 
    (VLAX-LDATA-GET "KEYMODE" KEYMODE) 
  ) 
  (VLAX-FOR LAY  LAYS 
    (SETQ LAYL (CONS (VLA-GET-NAME LAY) LAYL)) 
  ) 
  (setq LAY1 (REVERSE LAYL)) 
 
;;;  (setq dcl_id (load_dialog (make-dclgd))) 
  (setq  dcl_id 
   (load_dialog 
     "E:\\维尔利工作-2022\\CAD模版\\cad坐标<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">插件</a>\\LY插件缓存文件\\单线管道绘制.DCL" 
   ) 
  ) 
  (if (< dcl_id 0) 
    (vl-exit-with-value 0) 
  ) 
  (setq std 2) 
  (while (> std 1) 
    (new_dialog "DXGD" dcl_id) 
    (START_LIST "YL1") 
    (MAPCAR 'ADD_LIST LPN) 
    (END_LIST) 
    (START_LIST "DN1") 
    (MAPCAR 'ADD_LIST DNLST) 
    (END_LIST) 
    (START_LIST "LAY1") 
    (MAPCAR 'ADD_LIST LAY1) 
    (END_LIST) 
    (set_tile "CZ1" CZ) 
    (set_tile "N1" (RTOS N 2 0)) 
    (set_tile "XK1" (RTOS XK 2 0)) 
    (set_tile "YS1" (RTOS YS 2 0)) 
    (set_tile "YL1" (RTOS (vl-position PN LPN) 2 0)) 
    (set_tile "DN1"(RTOS (vl-position (RTOS DN 2 0) DNLST) 2 0)) 
    (set_tile "LAY1" (RTOS (vl-position LAY LAY1) 2 0)) 
    (action_tile "cancel" "(done_dialog 0)") 
    (action_tile "accept" "(DXGDSZ2 LPN DNLST LAY1)(done_dialog 1) ") 
    (action_tile "XYS" "(DXGDSZ3) ") 
    (setq STD (start_dialog)) 
    (unload_dialog dcl_id) 
  ) 
) 
(DEFUN DXGDSZ3 ( / COLOR) 
  (setq color (acad_colordlg 3)) 
  (IF color 
    (set_tile "YS1" (RTOS COLOR 2 0)) 
  ) 
) 
(DEFUN DXGDSZ2 ( LPN DNLST LAY1 / D11 LAY CZ PN XK YS KEYMODE N) 
  (SETQ CZ (get_tile "CZ1")) 
  (SETQ PN (nth (atoi (Get_tile "YL1")) LPN)) 
  (SETQ DN (ATOI (nth (atoi (Get_tile "DN1")) DNLST))) 
  (SETQ LAY (nth (atoi (Get_tile "LAY1")) LAY1)) 
  (SETQ XK (ATOI (get_tile "XK1"))) 
  (SETQ N (ATOI (get_tile "N1"))) 
  (SETQ YS (ATOI (get_tile "YS1")) 
  KEYMODE  "单线管道") 
  (VLAX-LDATA-PUT "KEYMODE" KEYMODE(LIST DN LAY CZ PN XK YS N) ) 
)

修改了arc3bug。2023.01.31

aggdqty · 发表于 2023-2-16 23:31:37

"E:\\维尔利工作-2022\\CAD模版\\cad坐标<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">插件</a>\\LY插件缓存文件\\单线管道绘制.DCL"
)

麻烦问下，这是什么，为什么S设置不了,谢谢

liuhe · 发表于 2023-2-17 08:32:51

aggdqty 发表于 2023-2-16 23:31
"E:\\维尔利工作-2022\\CAD模版\\cad坐标插件\\LY插件缓存文件\\单线管道绘制.DCL"
)

里面有dcl了，那个地址被我注释掉了，不要改代码应该就可以直接用

liuhe · 发表于 2023-2-17 08:35:12

aggdqty 发表于 2023-2-16 23:31
"E:\\维尔利工作-2022\\CAD模版\\cad坐标插件\\LY插件缓存文件\\单线管道绘制.DCL"
)

我上传了DCL文件，你下载试试吧

p-3-ianlcc · 发表于 2023-1-30 17:19:07

很不用的工具lisp，谢谢楼主的分享！
不过，可否请楼主也分享有“统计工具”的呢？
可以供下载使用。
因为绘画管线，最后是希望可以进行“数量计算”

中国梦 · 发表于 2023-1-30 21:41:51

谢谢楼主分享

czb203 · 发表于 2023-1-31 09:47:33

谢谢楼主分享

magicheno · 发表于 2023-1-31 15:20:43

感谢大佬分享

vladimir · 发表于 2023-2-3 09:31:48

非常不错的代码，谢谢楼主分享啊

whophy · 发表于 2023-2-3 22:44:43

很实用的程序

zxfddz · 发表于 2023-2-6 11:29:42

先试用看看

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

总图单线管布置插件---

本帖子中包含更多资源

评分