[编程交流] 双线flex lisp

;;; ------------------------------------------------------------------------
;;;    CreateFlex.lsp v1.1
;;;
;;;    Copyright © January, 2007
;;;    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 OldClayer OldFillMode
ActiveDoc Space FlexSize FlexStart TrunkLine EntList EntLayer StartPoint SidePoint ExtenLength LineStart
LineEnd  LineAngle 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 OldClayer (getvar "CLAYER"))
(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)
 )
) 
;; Setup layer for centerline
(FLEX_CREATE_LAYER "M-HVAC-CNTR" "Mechanical Plan - Ductwork centerline" "CENTER2" "25" "12" "0")
;; Run flex duct program
(FLEX_RUN) 
)
;;; ------------ GET USER VARIABLES SUB
(defun FLEX_RUN (/)
;; Get properties from current trunk line
(while (null (setq TrunkLine (car(nentsel "\n Select trunk to add flex to: "))))
 (princ "\n  Duct not selected")
)
(setq EntList (entget TrunkLine))
(setq FlexLayer (cdr (assoc 8 EntList)))
;; Set flex layer
(setvar "CLAYER" FlexLayer)
;; Set tee properties
(if (equal (cdr (assoc 0 EntList)) "LINE")
 (progn
  (setq LineStart (cdr (assoc 10 EntList)))
  (setq LineEnd (cdr (assoc 11 EntList)))
  (setq LineAngle (angle LineStart LineEnd))
  (setq TrunkSize (distance LineStart LineEnd))
  (setq FlexStart (polar LineStart LineAngle (/ (distance LineStart LineEnd) 2)))
  (setq FlexSize TrunkSize)
 )
 (progn
  (princ "\n Trunk must be a line. ")
  (FLEX_RUN)
 )
)
;; Get flex direction and endpoint
(setq SidePoint (getpoint FlexStart "\n Define flex direction "))
(setq TrunkDirection (FLEX_GET_PERP LineStart LineEnd SidePoint))
(setq FlexEnd (polar FlexStart TrunkDirection 3.0))
(FLEX_BLOCK FlexSize)
(FLEX_CREATE FlexStart EndPoint FlexSize)
)
;;; ------------ CREATE FLEXDUCT SUB
(defun FLEX_CREATE (FlexStart EndPoint FlexSize / PlineEnt VLPlineObj VLPlineLength FlexDuct1 FlexDuct2
FlexDuct1Pts FlexDuct2Pts FlexCap1)
;; Create flex duct construction line (centerline)
(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))
;; Create cap
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
;; Set properties for centerline
(vlax-put VLPlineObj 'Layer "M-HVAC-CNTR")
(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
)
;;; ------------ LAYER CREATION ROUINE
(defun FLEX_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList)
;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)  
 (if (FLEX_CHECK_LINETYPE (findfile "acad.lin") Linetype)
  (command "linetype" "load" Linetype "acad.lin" "")
  (setq Linetype "Continuous")
 )
)
;;; ------------ CREATE A LIST FOR ENTMAKE
(setq TmpList
 (list
  (cons 0 "LAYER")
  (cons 100 "AcDbSymbolTableRecord")
  (cons 100 "AcDbLayerTableRecord")
  (cons 70 0)
 )
)
;; Create layer name list
(setq TmpList (append TmpList (list (cons 2 Layer))))
;; Create layer color list
(setq TmpList (append TmpList (list (cons 62 (atoi Color)))))
;; Create layer linetype list
(setq TmpList (append TmpList (list (cons 6 Linetype))))
;; Create layer lineweight list
(setq TmpList (append TmpList (list (cons 370 (atoi Thickness)))))
;; Create layer plot list
(setq TmpList (append TmpList (list (cons 290 (atoi Plot)))))
;; Create layer from first item in the list
(entmake TmpList)      
;; Create layer description
(if(or(= 16.1 (atof(getvar "acadver")))(< 16.1 (atof(getvar "acadver"))))
 (progn
  (setq VLA-Obj(vla-Add (vla-Get-Layers ActiveDoc)Layer))
  (vla-Put-Description VLA-Obj Descpition)
 )
)
)
;;; ------------ CHECKS TO SEE IF A LINETYPE IS AVAILIBLE
(defun FLEX_CHECK_LINETYPE (LINFile Linetype / OpenFile LineNumber CurrentLine Result)
(setq OpenFile (open LINFile "r"))
(while (setq CurrentLine (read-line OpenFile))
 (if (wcmatch CurrentLine "`**")
  (progn    
   (setq LinetypeName (substr(car(FLEX_STRING_TO_LIST CurrentLine ","))2))
   (if (= (strcase Linetype) LinetypeName)
    (setq Result T)
   )
  )
 )
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun FLEX_STRING_TO_LIST (Stg Del / CurChr PosCnt TmpLst TmpStr)
(setq PosCnt 1
   TmpStr ""
)
(repeat (1+ (strlen Stg))
 (setq CurChr (substr Stg PosCnt 1))
 (if (= CurChr Del)
  (progn
   (setq TmpLst (cons TmpStr TmpLst))
   (setq TmpStr "")
  )
  (setq TmpStr (strcat TmpStr CurChr))
 )
 (setq PosCnt (1+ PosCnt))
)
(setq TmpLst (reverse TmpLst))
)
;; ------------ DEGREES TO RADIANS SUB ROUTINE
(defun FLEX_DTR (NumberOfDegrees) 
(* pi (/ NumberOfDegrees 180.0))
)
(defun FLEX_RTD (NumberOfRadians)
 (* 180.0 (/ NumberOfRadians pi))
)
;;; ------------ GET PERPENDICULAR POINT
(defun FLEX_GET_PERP (StartPoint EndPoint Point / EntList LineStart LineEnd LineAngle NewAngle PerpAngle)
(setq PerpStart (trans StartPoint 0 1))
(setq PerpEnd (trans EndPoint 0 1))
(setq PerpAngle (angle PerpStart PerpEnd))
(if (minusp (sin (- (angle PerpStart Point) PerpAngle)))     ;determine direction
 (setq NewAngle (- PerpAngle (/ pi 2)))                        ;if "below" -90 deg
 (setq NewAngle (+ PerpAngle (/ pi 2)))                        ;or "above" +90 deg
)
NewAngle
)
;;; ------------ RESET SYSEM VARIABLES
(defun FLEX_RESET_ENV (/)
;; Reset system variables
(setvar "ORTHOMODE" OldOrthoMode)
(setvar "OSMODE" OldOsmode)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
(setvar "CLAYER" OldClayer)
;; Reset undo marker
(command "undo" "End")
(setvar "CMDECHO" OldCmdEcho)
(princ) 
)
;;;
;;; Echos to the command line
(princ "\n CreateFlex v1.1 ©Timothy Spangler, \n  January, 2007....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo

;;;=======================[ FlexDuct.lsp ]==============================
;;; Author: Copyright© 2007 Charles Alan Butler 
;;; Contact or Updates  @  www.TheSwamp.org
;;; Version:  1.7   Feb. 21,2008
;;; Purpose: Create Flex Duct from a centerline that the user picks
;;;    Centerline may be anything vla-curve will handle
;;; Sub_Routines:      
;;;    makePline which creates a LW Polyline
;;; Restrictions: UCS is supported
;;;    Duct Layer is hard coded, see var Flexlayer
;;;    No error handler at this time
;;; Known Issues:
;;;    Tight curves cause pline jacket distortion
;;;    Added warning when this is about to occur

;;; ------------------------------------------------------------------------
;;;    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))
;; Create caps
(setq FlexCap1 (vlax-invoke space 'addline FlexDuct1Pts FlexDuct2Pts))
(setq FlexCap2 (vlax-invoke space 'addline FlexDuct3Pts FlexDuct4Pts))
(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