Wall LISP请求。
李，我还有一个Lisp程序的问题，我希望你能帮我哎呀，这不是工作用的，但会是父亲节礼物。我爸爸是一名承包商和房地产经纪人。最近，我向他介绍了autocad世界，他将主要使用autocad绘制基本建筑。所以我在寻找一种方法来自动创建墙，在正确的位置插入螺柱，并挤压到正确的高度等等。我在互联网上搜索过，只能找到其他人在寻找同样东西的参考资料。因此，如果你创建这个lisp，我认为其他人也会使用它。我脑海中描绘的是一个lisp，它向用户询问有关墙的一些信息，然后为他们绘制墙。我想象Lisp程序是这样的。。。。
启动lisp。
询问起点。
询问墙壁长度
询问墙壁高度。（挤出高度）
询问螺柱尺寸（长度/宽度）
询问螺柱间距。（始终从第一个螺柱居中..参见示例…）
询问板材厚度（示例中为“F”）
询问墙壁方位（示例中为0度）
要求起跑线一侧的墙应从中伸出。（用户将单击屏幕…起始线的右侧或左侧…）
我附上了一个例子，可以说，但我觉得需要一些进一步的解释。。。。非常感谢您抽出时间。你知道我真的很欣赏你的辛勤工作！我是认真的，我相信其他人也会觉得这个Lisp程序很有帮助！（我相信ReeMark早在10月份就在寻找这样的东西。）无论如何，让我知道什么没有意义。。。。
Wall Lisp示例。图纸 这是一项相当艰巨的任务——绝对是“能干的”，但非常乏味，也不好看。
我认为将DCL用于这种LISP也是很好的。 是的，因为整个父亲节“礼物”的事，我本来很想自己做，但我很快意识到我做不到。什么是DCL？这是我能做的事吗？ 只需升级到Autodesk Architecture。这一特点的存在，加上一百万其他选择和风格非常复杂的建筑设计。 这里有一些东西可以让你开始。它可以创建2D，但可以修复为在3D中创建所有内容。
你尽管痛斥吧。
;;; ------------------------------------------------------------------------
;;; PLAN_STUDWALL.lsp v1.0
;;;
;;; Copyright © December, 2006
;;; 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.
;;;
;;; -----------------------------------------------------------------------
(defun c:STUDWALL (/)(STUD_WALL "CMD" nil nil nil))
(defun STUD_WALL (RunType StudSize StudSpace DryWall / *error* OldClayer OldCmdEcho OldLunits OldLuPrec ActiveDoc Space StudSize StartPoint EndPoint StudSpace WallLength WallAngle Angle-180 Angle+90 Width Length NoStuds )
;;; 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)
)
;; Reset environment varialbes
(STUDWALL_RESET_ENV)
)
;;; End Error Handler ---------------------------------------------------
(STUDWALL_SET_ENV)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun STUDWALL_SET_ENV(/)
(setq OldClayer (getvar "CLAYER"))
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_undo" "BE")
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= (getvar "cvport") 1)
(vla-get-paperspace ActiveDoc)
(vla-get-modelspace ActiveDoc)
)
)
;; Create framing layer
(STUD_CREATE_LAYER "A-FRAM-WALL" "Framing Plan - Wall framing linework" "Continuous" "25" "157" "0")
(setvar "CLAYER" "A-FRAM-WALL")
;; Create wall
(if (= RunType "CMD")
(RUN_STUDWALL)
(GET_STUD_POINTS StudSize StudSpace DryWall)
)
)
;;; ------------ RUN STUDWALL
(defun RUN_STUDWALL (/)
;; Get wall thickness
(initget 1 "4 6 8")
(setq StudSize (getkword " \nEnter wall Thickness: (4=2x4/6=2x6/8=2x8)"))
;; Get stud spacing
(while (< (setq StudSpace (getreal " \nEnter stud spacing: "))6.0)
(alert " Stud spacing Needs to be greater than 6\" ")
)
;; Get drywall
(initget 1 "Yes y Y No n N")
(setq DryWall (strcase (getkword " \nAdd drywall?: (Yes/No)")))
(GET_STUD_POINTS StudSize StudSpace DryWall)
)
(defun GET_STUD_POINTS (StudSize StudSpace DryWall /)
;; Create stud block
(CREATE_STUD StudSize)
;; Define start and end points
(setq StartPoint (getpoint " \nDefine Start point for studwall: "))
(setq EndPoint (getpoint StartPoint " \nDefine end point for studwall: "))
;; Set wall variables
(setq WallLength (distance StartPoint EndPoint))
(setq WallAngle (angle StartPoint EndPoint))
(setq Angle-180 (- WallAngle (DTR 180)))
(setq Angle+90 (+ WallAngle (DTR 90)))
;; Justify start and end points
(setq StartPoint (polar StartPoint Angle+90 (/ Width 2)))
(setq EndPoint (polar EndPoint Angle+90 (/ Width 2)))
;; Create the wall
(CREATE_STUDWALL)
)
;;; ------------ CREATE STUDWALL
(defun CREATE_STUDWALL ( / Point Temp DWallLine1 DWallLine2 WallLine1 WallLine2 WallCenter WallEnd1 WallEnd2)
;; Create first stud
(INSERT_STUD BlockName (polar StartPoint WallAngle (/ Length 2)) WallAngle)
;; Count the number of studs
(setq NoStuds 1)
;; Create intermediate studs
(setq Point StartPoint)
(setq Temp (- WallLength 3))
(while (> Temp StudSpace)
(setq Point (polar Point WallAngle StudSpace))
(INSERT_STUD BlockName Point WallAngle)
(setq Temp (- Temp StudSpace))
;; Add to the stud count
(setq NoStuds (1+ NoStuds))
)
;; Create last stud
(INSERT_STUD BlockName (polar EndPoint Angle-180 (/ Length 2)) WallAngle)
;; Add to the stud count
(setq NoStuds (1+ NoStuds))
;; Create wall lines
(setq WallCenter (vlax-invoke Space 'addline StartPoint EndPoint))
(setq WallLine1 (car (vlax-invoke WallCenter 'offset (/ Width 2))))
(setq WallLine2 (car (vlax-invoke WallCenter 'offset (-(/ Width 2)Width))))
;; Delete centerline
(vlax-invoke WallCenter 'delete)
;; Add drywall
(if (= DryWall "YES")
(progn
(setq DWallLine1 (car (vlax-invoke WallLine1 'offset 0.5)))
(setq DWallLine2 (car (vlax-invoke WallLine2 'offset -0.5)))
(setq WallEnd1 (vlax-invoke Space 'addline (vlax-get DWallLine1 'Startpoint)(vlax-get DWallLine2 'Startpoint)))
(setq WallEnd2 (vlax-invoke Space 'addline (vlax-get DWallLine1 'Endpoint)(vlax-get DWallLine2 'Endpoint)))
)
(progn
(setq WallEnd1 (vlax-invoke Space 'addline (vlax-get WallLine1 'Startpoint)(vlax-get WallLine2 'Startpoint)))
(setq WallEnd2 (vlax-invoke Space 'addline (vlax-get WallLine1 'Endpoint)(vlax-get WallLine2 'Endpoint)))
)
)
;; Send stud count
(princ (strcat "\nThere are " (rtos NoStuds 5 0)" studs in the wall."))
;; Reset environment varialbes
(STUDWALL_RESET_ENV)
)
;;; ------------ LAYER CREATION ROUINE
(defun STUD_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)
;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (STUD_CHECK_LINETYPE (findfile "acad.lin") Linetype)
(command "linetype" "load" Linetype "acad.lin" "")
(setq Linetype "Continuous")
)
)
;;; ------------ CREATE A LIST FOR ENTMAKE
(setq TmpList
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(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)
(vlax-release-object VLA-Obj)
)
)
)
;;; ------------ CHECKS TO SEE IF A LINETYPE IS AVAILIBLE
(defun STUD_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(TGS:Stringtolist CurrentLine ","))2))
(if (= (strcase Linetype) LinetypeName)
(setq Result T)
)
)
)
)
(close OpenFile)
Result
)
;;; ------------ STRING TO LIST SUB ROUTINE
(defun TGS:StringToList (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))
)
;;; ------------ INSERT STUD BLOCK SUB
(defun INSERT_STUD (BlockName InsPoint RotAngle /)
(entmake
(list
(cons 0 "INSERT") ;***
(cons 2 BlockName) ;***
(cons 6 "BYLAYER")
;(cons 8 "0") ;Layer name
(cons 10 InsPoint) ;***
(cons 39 0.0)
(cons 41 1.0)
(cons 42 1.0)
(cons 43 1.0)
(cons 44 0.0)
(cons 45 0.0)
(cons 50 RotAngle)
(cons 62 256)
(cons 70 0)
(cons 71 0)
(cons 210 (list 0.0 0.0 1.0))
)
)
)
;;; ------------ CREATE STUD BLOCK SUB - DOES NOT INSERT BLOCK
(defun CREATE_STUD (StudSize /)
(setq OldLunits (getvar "LUNITS"))
(setq OldLuPrec (getvar "LUPREC"))
(setvar "LUNITS" 2)
(setvar "LUPREC" 1)
(cond
((= StudSize "4")(setq BlockName "2x4")(setq Length 1.5)(setq Width 3.5))
((= StudSize "6")(setq BlockName "2x6")(setq Length 1.5)(setq Width 5.5))
((= StudSize "8")(setq BlockName "2x8")(setq Length 1.5)(setq Width 7.5))
)
(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")
)
)
;; Left Side Line
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (- (/ Length 2) Length) (- (/ Width 2) Width) 0.0))
(cons 11 (list (- (/ Length 2) Length) (/ Width 2) 0.0))
(cons 8 "0")
(cons 62 256)
)
)
;; Bottom Line
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (- (/ Length 2) Length) (- (/ Width 2) Width) 0.0))
(cons 11 (list (/ Length 2) (- (/ Width 2) Width)0.0))
(cons 8 "0")
(cons 62 256)
)
)
;; Right Side Line
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (/ Length 2) (- (/ Width 2) Width)0.0))
(cons 11 (list (/ Length 2) (/ Width 2)0.0))
(cons 8 "0")
(cons 62 256)
)
)
;; Top Line
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (/ Length 2) (/ Width 2)0.0))
(cons 11 (list (- (/ Length 2) Length) (/ Width 2) 0.0))
(cons 8 "0")
(cons 62 256)
)
)
;; Left Cross
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (- (/ Length 2) Length) (/ Width 2) 0.0))
(cons 11 (list (/ Length 2) (- (/ Width 2) Width)0.0))
(cons 8 "0")
(cons 62
)
)
;; Right Cross
(entmake
(list
(cons 0 "LINE")
(cons 10 (list (- (/ Length 2) Length) (- (/ Width 2) Width) 0.0))
(cons 11 (list (/ Length 2) (/ Width 2)0.0))
(cons 8 "0")
(cons 62
)
)
;; Endblock
(entmake
'((0 . "ENDBLK"))
)
)
(princ "\n\n Block found in drawing")
)
(setvar "LUNITS" OldLunits)
(setvar "LUPREC" OldLuPrec)
BlockName
)
;; ------------ DEGREES / RADIANS SUB ROUTINES
(defun DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
;;; ------------ RESET SYSEM VARIABLES
(defun STUDWALL_RESET_ENV (/)
(command "_undo" "End")
(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)
(princ)
)
;;;
;;; Echos to the command line
(princ "\n CreateStudWall v1.0 ©Timothy Spangler, \nDecember, 2006....loaded.")
(terpri)
(princ "Type \"STUDWALL\" to begin")
(print)
;;; End echo
DCL=“对话框控制语言”
以这些为例：
http://www.cadtutor.net/forum/showthread.php?t=35234
http://www.cadtutor.net/forum/showthread.php?t=33919
然后输入不限于命令行。
但我认为这是一件很麻烦的事情，可以很容易地完成，要么使用Styk建议的软件，要么将其缩小到一个LISP，只计算你需要的螺柱数量。
我可以补充一点，我不是这个论坛的唯一成员，这是一个帮助和建议网站。请记住，我自愿花时间帮助别人，没有任何报酬——我非常怀疑你会发现很多人愿意花很多时间为你写一个程序，没有任何形式的回报。本网站的会员不是为您服务，而是提供建议。我意识到我在过去写过一些被要求的程序，但我必须对在这些程序上花费的时间划一条界限。 是的，我想这不是个好主意。请记住，对我来说，它们看起来都很复杂，但你可以在几分钟内创建它们。这就是为什么我觉得我至少可以问一下。
我理解，谢谢你过去所做的工作。此外，我同意你的观点，没有多少人愿意做你所做的，我非常感谢！如果我越界了，我道歉。请接受我的道歉。我会探索其他选择，继续自学，这样我就可以为自己编写程序，希望也能像你们为我所做的那样为别人编写程序。 这是我90年代末写的一篇文章。Compurserve天哇-大卫
螺柱。拉链 谢谢Tim Spangler，你发布的代码是一个很好的起点。这几乎正是我脑海中想象的。我搜索了类似的东西，但在发布之前没有找到。我想我看起来不够努力！非常感谢。
此外，我将研究acad建筑，它似乎是我父亲所需要的。谢谢大家的意见。 我非常怀疑你的要求需要几分钟。远不止这些。
页:
[1]
2