这是一个很酷的工具！
布拉德 以下是后续内容。希望这对你有用。
;;; ------------------------------------------------------------------------
;;; 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, \nMay, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
提姆，
那是猫屁股！！！！！！！
你是Lisp程序的国王！！！！！
大家好，蒂姆！！！！！
非常感谢，如果有什么我能做的，请告诉我。
你卑微的仆人
账单 [脸红]
哦，你不是那个意思！
[/脸红]
很高兴我能帮忙！ 提姆，
我现在可以开始卑躬屈膝了吗？
我想知道你是否可以采取最新的Lisp程序你发送和chande它终止在一个直端像以前一样？我需要不同扩散器连接的终端类型。您为我创建和修改的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 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, \nMay, 2008....loaded.")
(terpri)
(princ "C:FLEX")
(print)
;;; End echo
提姆，
我收到这个错误消息，然后flex直接终止。
“命令：
FLEXT公司
输入弹性尺寸：
定义弹性起点：
定义弯曲方向：
***程序错误：无函数定义：FLEX\u RESET\u ENV***；错误：错误
在*error*function内发生没有函数定义：FLEX\u RESET\u ENV 提姆，
我的错。弹性过大。lsp例程加载。太棒了！！！！
我将用我的一生在论坛的最高峰喊出你的名字！
账单 很高兴听到你收到了。我打算建议重新复制代码，以确保您没有错过a（或a）。它每次都会抓住你。 蒂姆-
我已经看过你的双线flex的lisp例程了。它对我很有效，我非常喜欢。是否可以将外部线条修改为之字形，而不是曲线？有点难以解释，但希望你能理解。非常感谢-Dave
页:
1
[2]