如何将while循环添加到此乐筑天下 - Powered by Discuz! Archiver

xpr0 发表于 2022-7-5 17:09:51

如何将while循环添加到此

大家好，every1，我想在这个lisp中添加while循环。因此，它不会在单次执行后结束，并继续运行，直到我按ESC或ENTER键。
plz帮助

;;By Andrea Andreetti 2008-11-27 ;;
;; ;;
;; D U C T A T T A C H ;;
;;          Takeoff Disttance 100 ;;
;;       ;;
;;

(princ "\nDuctAttach v.1.0 By: Andrea Andreetti")
(vl-load-com)
(defun c:DuctAttach (/ Ent_10 Ent_11 Ent_62 Ent_0 Inter_L1 Inter_L2 entData Basepoint1 Basepoint2
            Dduct grjp1 grjp2 ficp1 ficp2 ficpX #DCswitch Dway1 Dway2 Dway3 Dway4 ArcEnt
            dr_sel1 dr_sel2 SLi_0 VLA_line1 VLA_line1_start VLA_line1_end ArcEntLIST
            VLA_line2 VLA_line2_start VLA_line2_end 4po GEN_clayercolor Input entData arcX arcY
               newLine 1_sp 1_sp 3_sp 4_sp)

(setq ArcEnt nil)

;; Degre Conversion ;;
;;
(defun dtr (a)
(* pi (/ a 180.0))
)
(defun rtd (a)
(/ (* a 180) pi)
)
;;
;; Degre Conversion ;;

(DCclean)
(if (not #DCswitch)(setq #DCswitch 0))
(setq dr_sel1 nil
dr_sel2 nil)

(while (or (= dr_sel1 nil)
      (/= (cdr (assoc 0 (setq dr_sel1data (entget (car dr_sel1))))) "LINE")
   )
(setq dr_sel1 (entsel "\nSelect the Branch Duct Lines"))
)

(while (or (= dr_sel2 nil)
      (/= (cdr (assoc 0 (setq dr_sel2data (entget (car dr_sel2))))) "LINE")
   )
(setq dr_sel2 (entsel "\nSelect the Branch Duct Lines"))
)

(if (and dr_sel1 dr_sel2)
(progn
(setq SLi_0 (cdr (assoc 8 (entget (car dr_sel1)))))
(setq VLA_line1 (vlax-ename->vla-object (car dr_sel1)))
(setq VLA_line1_start (vlax-get VLA_line1 'startpoint))
(setq VLA_line1_end (vlax-get VLA_line1 'endpoint))

(setq VLA_line2 (vlax-ename->vla-object (car dr_sel2)))
(setq VLA_line2_start (vlax-get VLA_line2 'startpoint))
(setq VLA_line2_end (vlax-get VLA_line2 'endpoint))

(if (< (getvar "LUNITS") 3)
(setq 4po 100)
(setq 4po 4)
)
(setq GEN_clayercolor (cdr (assoc 62 (entget (tblobjname "layer" (getvar "clayer"))))))

(defun *error* (msg)
(DCclean)
(if VLA_line0 (progn (vlax-release-object VLA_line0)(setq VLA_line0 nil)))
(if VLA_line1 (progn (vlax-release-object VLA_line1)(setq VLA_line1 nil)))
(if Nline (progn (vlax-release-object Nline)(setq Nline nil)))
(if Sline (progn (vlax-release-object Sline)(setq Sline nil)))

(princ msg)
)

(while (and (setq Input (grread T 4 4))
         (or (= (car Input) 5)
            (and
            (= (car Input) 2)
            (= (cadr Input) 9)
            )
            )
      )

;;SWITCH MODE ;;
   ;;
(if (and (= (car Input) 2)
   (= (cadr Input) 9)
)
(progn
(setq Input (grread T 4 4))
(if (> #DCswitch 5)
(setq #DCswitch 0)
(setq #DCswitch (1+ #DCswitch))
)

(progn
(if (eq #DCswitch 0) (princ "\n- Switched to Square/Square excentric connection -"))
(if (eq #DCswitch 1) (princ "\n- Switched to Square/Square Straight connection -"))
(if (eq #DCswitch 2) (princ "\n- Switched to Square/Square Concentric connection -"))
(if (eq #DCswitch 3) (princ "\n- Switched to Round/Square Concentric connection -"))
(if (eq #DCswitch 4) (princ "\n- Switched to Round/Round Concentric connection -"))
(if (eq #DCswitch 4) (princ "\n- Switched to Round/Round Straight connection -"))

)
)
)
(DCswitch)
;;
;;SWITCH MODE ;;

)
)
)
(DCclean)

(if (eq (car Input) 3)
(Ductattach_exe)
)

)
;;
;; ;;
;; D U C T A T T A C H ;;
;;       ;;

;; ;;
;; D C S W I T C H ;;
;;       ;;
;;
(defun DCswitch (/ )

(if (and (setq EntName (car (nentselp (setq cursorLocation (cadr Input)))))
(not (eq Iname EntName))
   )
   (progn
   (DCclean)
(setq entData (entget EntName))
(setq Ent_0 (cdr (assoc 0 entData)))
(if (setq Ent_62 (assoc 62 entData))
(setq Ent_62 (cdr Ent_62))
(setq Ent_62 GEN_clayercolor)
)
(setq Ent_10 (cdr (assoc 10 entData)))
(setq Ent_11 (cdr (assoc 11 entData)))

(if (eq Ent_0 "LINE")
(progn
(setq VLA_line0 (vlax-ename->vla-object (cdr (car entData))))

(setq Inter_L1 (vlax-invoke VLA_line0 'intersectwith VLA_line1 acExtendBoth))
(setq Inter_L2 (vlax-invoke VLA_line0 'intersectwith VLA_line2 acExtendBoth))
(if (and Inter_L1 Inter_L2)
(progn
(if (<
      (distance Inter_L1 VLA_line1_start)
      (distance Inter_L1 VLA_line1_end)
   )
(setq Basepoint1 VLA_line1_end)
(setq Basepoint1 VLA_line1_start)
)
(if (<
      (distance Inter_L2 VLA_line2_start)
      (distance Inter_L2 VLA_line2_end)
   )
(setq Basepoint2 VLA_line2_end)
(setq Basepoint2 VLA_line2_start)
)

(setq Dduct (+ (distance Basepoint1 Basepoint2) 4po))

(setq grjp1 (polar Inter_L1 (angle Inter_L1 Basepoint1) 4po))
(setq grjp2 (polar Inter_L2 (angle Inter_L2 Basepoint2) 4po))

(if (/= (distance grjp1 Inter_L2)(distance grjp2 Inter_L1))
(if (>(distance grjp1 Inter_L2)(distance grjp2 Inter_L1))
(progn

(setq ficp1 (polar grjp1 (+ (angle inter_L1 grjp1) (dtr 90)) 4po))
(setq ficp2 (polar grjp1 (- (angle inter_L1 grjp1) (dtr 90)) 4po))
(if (< (distance ficp1 grjp2)(distance ficp2 grjp2))
(setq ficpx ficp1)
(setq ficpx ficp2)
)
(setq grjp2 (inters grjp1 ficpx inter_L2 basepoint2 nil))

)

(progn
(setq ficp1 (polar grjp2 (+ (angle inter_L2 grjp2) (dtr 90)) 4po))
(setq ficp2 (polar grjp2 (- (angle inter_L2 grjp2) (dtr 90)) 4po))
(if (< (distance ficp1 grjp1)(distance ficp2 grjp1))
(setq ficpx ficp1)
(setq ficpx ficp2)
)
(setq grjp1 (inters grjp2 ficpx inter_L1 basepoint1 nil))

)
)
)

;;joint Line
(grdraw Basepoint1 grjp1 Ent_62 1)
(grdraw Basepoint2 grjp2 Ent_62 1)
(grdraw grjp1 grjp2 Ent_62 1)

;;Square/Square excentric connection ;;
   ;;
(if (= #DCswitch 0)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(if (<
(distance cursorLocation Inter_L1)
(distance cursorLocation Inter_L2)
)
(progn
(setq Dway1 grjp1)
(setq Dway2 (polar Inter_L1 (angle Inter_L2 Inter_L1) 4po))
(setq Dway3 grjp2
   Dway4 Inter_L2)
)
(progn
(setq Dway1 grjp2)
(setq Dway2 (polar Inter_L2 (angle Inter_L1 Inter_L2) 4po))
(setq Dway3 grjp1
   Dway4 Inter_L1)
)
)
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Square/Square excentric connection ;;

;;Switched to Square/Square Straight connection ;;
   ;;
(if (= #DCswitch 1)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 Inter_L1
Dway3 grjp2
   Dway4 Inter_L2
)
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Switched to Square/Square Straight connection ;;

;;Switched to Square/Square Concentric connection ;;
   ;;
(if (= #DCswitch 2)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 (polar Inter_L1 (angle Inter_L2 Inter_L1) (/ 4po 2))
Dway3 grjp2
   Dway4 (polar Inter_L2 (angle Inter_L1 Inter_L2) (/ 4po 2))
)
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Switched to Square/Square Concentric connection ;;

;;Switched to Round/Square Concentric connection ;;
   ;;
(if (= #DCswitch 3)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 (polar Inter_L1 (angle Inter_L2 Inter_L1) (/ 4po 2))
Dway3 grjp2
   Dway4 (polar Inter_L2 (angle Inter_L1 Inter_L2) (/ 4po 2))
)
(setq Rj1 (polar Dway1 (angle Inter_L1 Basepoint1) (* 4po 0.75)))
(setq Rj2 (polar Dway3 (angle Inter_L2 Basepoint2) (* 4po 0.75)))
(grdraw Rj1 Rj2 33 1)
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Switched to Round/Square Concentric connection ;;

;;Switched to Round/Round Concentric connection ;;
   ;;
(if (= #DCswitch 4)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 (polar Inter_L1 (angle Inter_L2 Inter_L1) (/ 4po 2))
Dway3 grjp2
   Dway4 (polar Inter_L2 (angle Inter_L1 Inter_L2) (/ 4po 2))
)
(setq Rj1 (polar Dway1 (angle Inter_L1 Basepoint1) (* 4po 0.75)))
(setq Rj2 (polar Dway3 (angle Inter_L2 Basepoint2) (* 4po 0.75)))
(grdraw Rj1 Rj2 33 1)

;;Draw ARC
(setq midjoint (polar Dway2 (angle Dway2 Dway4) (/ (distance Dway2 Dway4) 2)))
(setq cenOFarc (polar midjoint (+ (angle Dway2 Dway4) (dtr 90)) 4po))
(if (> (distance cenOFarc Dway1)(distance midjoint Dway1))
(setq cenOFarc (polar midjoint (- (angle Dway2 Dway4) (dtr 90)) 4po))
)

(setq arcX (polar midjoint (- (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq arcY (polar midjoint (+ (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq ArcEntLIST
(list
   '(0 . "ARC");;Type
   (cons 8 SLi_0);;Layer
   '(100 . "AcDbCircle");;Catégorie
   (cons 10 cenOFarc);;Center Point
   (cons 40 (distance cenOFarc Dway2));;Radius
   '(100 . "AcDbArc")
   (cons 50 (angle cenOFarc arcX));;Dway2))
   (cons 51 (angle cenOFarc arcY));;Dway4))
         (cons 62 Ent_62)
)
)

(setq ArcEnt (entmakex ArcEntLIST))
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Switched to Round/Round Concentric connection ;;

;;Switched to Round/Round Straight connection ;;
   ;;
(if (= #DCswitch 5)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
      ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 Inter_L1
Dway3 grjp2
   Dway4 Inter_L2
)
(setq Rj1 (polar Dway1 (angle Inter_L1 Basepoint1) (* 4po 0.75)))
(setq Rj2 (polar Dway3 (angle Inter_L2 Basepoint2) (* 4po 0.75)))
(grdraw Rj1 Rj2 33 1)

;;Draw ARC
(setq midjoint (polar Dway2 (angle Dway2 Dway4) (/ (distance Dway2 Dway4) 2)))
(setq cenOFarc (polar midjoint (+ (angle Dway2 Dway4) (dtr 90)) 4po))
(if (> (distance cenOFarc Dway1)(distance midjoint Dway1))
(setq cenOFarc (polar midjoint (- (angle Dway2 Dway4) (dtr 90)) 4po))
)

(setq arcX (polar midjoint (- (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq arcY (polar midjoint (+ (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))

(setq ArcEntLIST
(list
   '(0 . "ARC");;Type
   (cons 8 SLi_0);;Layer
   '(100 . "AcDbCircle");;Catégorie
   (cons 10 cenOFarc);;Center Point
   (cons 40 (distance cenOFarc Dway2));;Radius
   '(100 . "AcDbArc")
   (cons 50 (angle cenOFarc arcX))
   (cons 51 (angle cenOFarc arcY))
         (cons 62 Ent_62)
)
)
(setq ArcEnt (entmakex ArcEntLIST))
(setq #DCswitchOLD #DCswitch)
)
)
   ;;
;;Switched to Round/Round Straight connection ;;

;;GRDRAW Connection
(grdraw Dway1 Dway2 Ent_62 1)
(grdraw Dway3 Dway4 Ent_62 1)

)
)
)
)
(if (= (car Input) 11)(DCclean))
)
)
)

;;
;; ;;
;; D C S W I T C H ;;
;;       ;;

;; ;;
;; DUCTATTACH_EXE ;;
;;       ;;
;;

(defun Ductattach_exe ()

(if (and Dway1 Dway2 Dway3 Dway4)
(progn

(setq actdoc    (vla-get-activedocument (vlax-get-acad-object)))
(setq space    (if (= (getvar "cvport") 1)
   (vla-get-paperspace actdoc)
   (vla-get-modelspace actdoc)
   )
)

(vla-put-StartPoint VLA_line1 (vlax-3d-point basepoint1))
(vla-put-EndPoint VLA_line1 (vlax-3d-point grjp1))

(vla-put-StartPoint VLA_line2 (vlax-3d-point basepoint2))
(vla-put-EndPoint VLA_line2 (vlax-3d-point grjp2))

(setq newLine (vlax-invoke space 'addline Dway1 Dway3))
(NLINE_chprop newline VLA_line1)

(setq newLine (vlax-invoke space 'addline Dway3 Dway4))
(NLINE_chprop newline VLA_line1)

(setq newLine (vlax-invoke space 'addline Dway1 Dway2))
(NLINE_chprop newline VLA_line1)

;; Round Duct Joint connection
(if (> #DCswitch 2)
(progn
(setq newLine (vlax-invoke space 'addline Rj1 Rj2))
;;Layer
(setq N_layer (vla-get-layer VLA_line1))
(vla-put-layer newLine N_layer)
;;Color
(vla-put-color newLine "33")

;;Linetype
;;Assume that ACAD.LIN exist and contain the ACAD_ISO03W100 Linetype.
(if (not (member "ACAD_ISO03W100" (mapcar 'strcase (ai_table "LTYPE" 0))))
(vl-cmdf "._linetype" "_L" "ACAD_ISO03W100" "acad.lin" ""))
(vla-put-linetype newline "ACAD_ISO03W100")

);_progn
);_if

;; Round Duct to Round Duct ARC design
(if (> #DCswitch 3)
(progn
(if ArcEntLIST (entmakex ArcEntLIST))
(setq newarc (vlax-ename->vla-object (entlast)))
(NLINE_chprop newarc VLA_line1)

(setq 1_sp (vlax-get VLA_line0 'startpoint))
(setq 4_sp (vlax-get VLA_line0 'endpoint))

(if (> (distance 1_sp Dway2)(distance 1_sp Dway4))
(progn
(setq 2_sp Dway4)
(setq 3_sp Dway2)
)
(progn
(setq 3_sp Dway4)
(setq 2_sp Dway2)
)
)
(vla-put-StartPoint VLA_line0 (vlax-3d-point 1_sp))
(vla-put-Endpoint VLA_line0 (vlax-3d-point 2_sp))
(setq newLine (vlax-invoke space 'addline 3_sp 4_sp))
(NLINE_chprop newline VLA_line0)
)
)
);_progn
)
)
;;
;; ;;
;; DUCTATTACH_EXE ;;
;;       ;;

;; ;;
;; NLINE_chprop ;;
;;       ;;
;;
(defun NLINE_chprop (Nline Sline)

;;Linetype
(setq N_linetype (vla-get-linetype Sline))
(vla-put-linetype NLine N_linetype)
;;Layer
(setq N_layer (vla-get-layer Sline))
(vla-put-layer NLine N_layer)
;;Color
(setq N_color (vla-get-Color Sline))
(vla-put-color NLine N_color)
;;Thickness
(setq N_thickness (vla-get-Thickness Sline))
(vla-put-Thickness NLine N_thickness)
)
;;
;; ;;
;; NLINE_chprop ;;
;;       ;;

;; ;;
;; DCclean ;;
;;       ;;
;;
(defun DCclean ()
(if ArcEnt (progn (entdel ArcEnt)(setq ArcEnt nil)))
(redraw)
)

;;
;; Cclean ;;
;;       ;;

marko_ribar 发表于 2022-7-5 17:36:12

也许，在启动lisp之前先命令MULTIPLE。。。

xpr0 发表于 2022-7-5 17:44:57

thanx fr ur回复marko ribar。如何将该命令多次添加到此调用lisp的宏中。
^C^C(if (not c:DuctAttach)(load "DuctAttach" nil));DuctAttach;

marko_ribar 发表于 2022-7-5 17:57:00

不确定，但您是否尝试过：

^C^C(if (not c:DuctAttach)(load "DuctAttach" nil));MULTIPLE;DuctAttach;

xpr0 发表于 2022-7-5 18:11:01

thanx很多marko_ribar它起了作用。

页: [1]

乐筑天下's Archiver

如何将while循环添加到此