双线flex lisp
大家好，第一次来，请耐心等待。
我正在寻找一个lisp将绘制二维软风管。这个怪物存在吗？
账单 当然了！这是我作为HVAC套件的一部分编写的一个。
;;; ------------------------------------------------------------------------
;;; 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
LineEndLineAngle 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 "\nDuct 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, \nJanuary, 2007....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
它需要修改以满足您的需要。我通常选择主干线。从中可以得到flex的大小和层。如果你需要，我可以修改它以满足你的需要。 提姆，
当我在命令行中键入Flex时，会收到错误消息，
***程序错误：错误的参数类型：STRINGP NIL***
我做错了什么？
账单 让我调查一下。。。 下面是另一个要尝试的lisp：
;;;=======================[ 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
Flex 17驾驶室。LSP
试试这个。我删除了所有内容并使其独立
;;; ------------------------------------------------------------------------
;;; 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, \nMay, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
看看这是否更好。 提姆，
它现在可以工作了，但是有没有一种方法可以显示在具有圆形末端的扩散器处终止的柔性？有点难以解释。 提姆，
你还和我在一起吗？我喜欢这个Lisp程序的程序，非常感谢。你能让它以圆的一端结束吗？ 对不起，最近两天有点忙。让我回家试一试托尼。我今晚晚些时候再发。 提姆，
很高兴听到你还在那里。有点担心。。。英雄联盟
你能把中心线也去掉吗？这个lisp工作得很好，真的让管网看起来很真实。再次感谢！
页:
[1]
2