[编程交流] 双线flex lisp

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;    WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;    PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;;    PROGRAMMER.
;;;
;;; -----------------------------------------------------------------------
;;; ------------ COMMAND LINE FUNCTIONS
(defun c:FLEX (/)(FLEX_START))
;;; ------------ MAIN FUNCTION
(defun FLEX_START (/ *error* OldCmdEcho OldOrthoMode OldOsmode OldLunits OldLunits OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine BlockName FlexEnd)
;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)         
 (if (not (member MSG '("Function cancelled" "quit / exit abort")))
  (princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
  (princ "\n... Program Cancelled ...")
 )
 (while (< 0 (getvar "cmdactive"))
  (command)
 )
 (FLEX_RESET_ENV)
)
;;; End Error Handler ---------------------------------------------------
(FLEX_SET_ENV)
)
;;; ------------ SETUP FLEXDUCT ENVIRONMENT SUB
(defun FLEX_SET_ENV (/)
;; Set sysetm variable
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOrthoMode (getvar "ORTHOMODE"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setq OldFillMode (getvar "FILLMODE"))
(setvar "CMDECHO" 0)
;; Set undo marker
(command "undo" "Begin")
(setvar "ORTHOMODE" 0)
(setvar "OSMODE" 514)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setvar "FILLMODE" 0)
;; Load VLISP funtionality
(vl-load-com)
;; Set Vlisp Environment variables
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
 (if (= (getvar "cvport") 1)
  (vla-get-paperspace ActiveDoc)
  (vla-get-modelspace ActiveDoc)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexCap1 FlexCap2)
(if (not (setq FlexSize (getreal "\n Enter flex size: <6"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)
(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))
(command "_pline" FlexStart "width" FlexSize FlexSize FlexEnd "arc")
(while (> (getvar "cmdactive") 0)
 (command PAUSE)
) 
(setq PlineEnt (entget(entlast)))
(setq VLPlineObj (vlax-ename->vla-object (cdr(assoc -1 PlineEnt))))
(setq VLPlineLength (fix (vlax-get VLPlineObj 'length)))
;; Change width to 0  (all for astetics)
(vlax-put VLPlineObj 'ConstantWidth 0.0) 
(setvar "FILLMODE" OldFillMode)
;; Add "flex" to duct
(command "divide" (entlast) "block" BlockName "y" VLPlineLength)
;; Create flex duct sides
(setq FlexDuct1 (car (vlax-invoke VLPlineObj 'offset (/ FlexSize 2))))
(setq FlexDuct2 (car (vlax-invoke VLPlineObj 'offset (-(/ FlexSize 2)FlexSize))))
;; Get the end points of the sides
(setq FlexDuct1Pts (vlax-curve-getEndPoint FlexDuct1))
(setq FlexDuct2Pts (vlax-curve-getEndPoint FlexDuct2))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))
(setq FlexDuct5Pts (vlax-curve-getEndPoint VLPlineObj))
;; Create caps
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))
(vlax-invoke space 
'addarc 
 FlexDuct5Pts 
 (/ FlexSize 2)
 (angle FlexDuct2Pts FlexDuct1Pts)
 (angle FlexDuct1Pts FlexDuct2Pts)
)
(vla-delete VLPlineObj)
(FLEX_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun FLEX_BLOCK (FlexSize /)
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)
(setq BlockName (strcat "FLEX-" (rtos FlexSize 5 2)))
(if (= (tblsearch "block" BlockName) nil) 
 (progn 
  (entmake
   (list
    (cons 0 "BLOCK")
    (cons 2 BlockName)
    (cons 70 64)
    (cons 10 (list 0.0 0.0 0.0))
    (cons 8 "0")
   )
  ) 
  (entmake
   (list
    (cons 0 "LINE")
    (cons 10 (list 0.0 (- (/ FlexSize 2) FlexSize) 0.0))
    (cons 11 (list 0.0 (/ FlexSize 2) 0.0))
    (cons 8 "0")
    (cons 62 9)
   )
  )
  (entmake
   '((0 . "ENDBLK"))
  ) 
 ) 
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)
;; Reset system variables
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
;; Reset undo marker
(command "undo" "End")
(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.2
;;;
;;;    Copyright © May, 2008
;;;    Timothy G. Spangler
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;    WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;    PURPOSE AND OF MERCHANTIBILITY ARE HEREBY DISCLAIMED BY THE
;;;    PROGRAMMER.
;;;
;;; -----------------------------------------------------------------------
;;; ------------ COMMAND LINE FUNCTIONS
(defun c:FLEX (/)(FLEX_START))
;;; ------------ MAIN FUNCTION
(defun FLEX_START (/ *error* OldCmdEcho OldOrthoMode OldOsmode OldLunits OldLunits OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine BlockName FlexEnd)
;;; Begin Error Handler -------------------------------------------------
(defun *error* (MSG)         
 (if (not (member MSG '("Function cancelled" "quit / exit abort")))
  (princ (strcat "\n*** Program Error: " (strcase MSG) " ***"))
  (princ "\n... Program Cancelled ...")
 )
 (while (< 0 (getvar "cmdactive"))
  (command)
 )
 (FLEX_RESET_ENV)
)
;;; End Error Handler ---------------------------------------------------
(FLEX_SET_ENV)
)
;;; ------------ SETUP FLEXDUCT ENVIRONMENT SUB
(defun FLEX_SET_ENV (/)
;; Set sysetm variable
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOrthoMode (getvar "ORTHOMODE"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setq OldFillMode (getvar "FILLMODE"))
(setvar "CMDECHO" 0)
;; Set undo marker
(command "undo" "Begin")
(setvar "ORTHOMODE" 0)
(setvar "OSMODE" 514)
(setvar "LUNITS" 2)
(setvar "LUPREC" 4)
(setvar "FILLMODE" 0)
;; Load VLISP funtionality
(vl-load-com)
;; Set Vlisp Environment variables
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
 (if (= (getvar "cvport") 1)
  (vla-get-paperspace ActiveDoc)
  (vla-get-modelspace ActiveDoc)
 )
)  
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/ FlexStart EndPoint FlexSize PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexDuct3Pts FlexDuct4Pts FlexDuct5Pts FlexCap1 FlexCap2 CloseOpt)
(if (not (setq FlexSize (getreal "\n Enter flex size: <6"> ")))
 (setq FlexSize 6.0)
)
(FLEX_BLOCK FlexSize)
(setq FlexStart (getpoint "\n Define flex start point: "))
(setq FlexEnd (getpoint FlexStart "\n Define flex direction: "))
(setq FlexEnd (polar FlexStart (angle FlexStart FlexEnd) 3.0))
(command "_pline" FlexStart "width" FlexSize FlexSize FlexEnd "arc")
(while (> (getvar "cmdactive") 0)
 (command PAUSE)
) 
(setq PlineEnt (entget(entlast)))
(setq VLPlineObj (vlax-ename->vla-object (cdr(assoc -1 PlineEnt))))
(setq VLPlineLength (fix (vlax-get VLPlineObj 'length)))
;; Change width to 0  (all for astetics)
(vlax-put VLPlineObj 'ConstantWidth 0.0) 
(setvar "FILLMODE" OldFillMode)
;; Add "flex" to duct
(command "divide" (entlast) "block" BlockName "y" VLPlineLength)
;; Create flex duct sides
(setq FlexDuct1 (car (vlax-invoke VLPlineObj 'offset (/ FlexSize 2))))
(setq FlexDuct2 (car (vlax-invoke VLPlineObj 'offset (-(/ FlexSize 2)FlexSize))))
;; Get the end points of the sides
(setq FlexDuct1Pts (vlax-curve-getEndPoint FlexDuct1))
(setq FlexDuct2Pts (vlax-curve-getEndPoint FlexDuct2))
(setq FlexDuct3Pts (vlax-curve-getStartPoint FlexDuct1))
(setq FlexDuct4Pts (vlax-curve-getStartPoint FlexDuct2))
(setq FlexDuct5Pts (vlax-curve-getEndPoint VLPlineObj))
;; Create caps
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))
;; Check for losing option
(initget 1 "Blunt Arched")
(setq CloseOpt (getkword "\n Enter end condition: (Arched/Blunt)"))
(if (= "Blunt" CloseOpt)
 (setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
 (progn
  (vlax-invoke space 
  'addarc 
   FlexDuct5Pts 
   (/ FlexSize 2)
   (angle FlexDuct2Pts FlexDuct1Pts)
   (angle FlexDuct1Pts FlexDuct2Pts)
  )
 )
)
;; Delete centerline
(vla-delete VLPlineObj)
(FLEX_RESET_ENV)
)
;;; ------------ CREATE FLEX LINE BLOCK SUB - DOES NOT INSERT BLOCK
(defun FLEX_BLOCK (FlexSize /)
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)
(setq BlockName (strcat "FLEX-" (rtos FlexSize 5 2)))
(if (= (tblsearch "block" BlockName) nil) 
 (progn 
  (entmake
   (list
    (cons 0 "BLOCK")
    (cons 2 BlockName)
    (cons 70 64)
    (cons 10 (list 0.0 0.0 0.0))
    (cons 8 "0")
   )
  ) 
  (entmake
   (list
    (cons 0 "LINE")
    (cons 10 (list 0.0 (- (/ FlexSize 2) FlexSize) 0.0))
    (cons 11 (list 0.0 (/ FlexSize 2) 0.0))
    (cons 8 "0")
    (cons 62 9)
   )
  )
  (entmake
   '((0 . "ENDBLK"))
  ) 
 ) 
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Release ActiveX objects
(vlax-release-object ActiveDoc)
(vlax-release-object Space)
;; Reset system variables
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
;; Reset undo marker
(command "undo" "End")
(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.2© \n Timothy Spangler, \n  May, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo