钢形状-动态/参数
没关系。。。。。**** Hidden Message ***** 即使在转换回2004年后，我也无法在ACAD2006中打开DWG。它返回纯线条工作=- -==- -==- -==- -==- -==- -==- -==-
;;================================================================
(vl-load-com)
(defun c:wshapes (/ path filename handle stream result InsBlk insLay wShapeDBfn attdata *error*)
(setq InsLay "0") ; layer to use for Block Insert
;; add attributes to BlockDef
;;AttData list of list with 3 strings'((TAG Prompt DefVal)("DATA1" "Prompt1" "DefValue1"))
;;This example add 2 hidden attributes to each new block
(setq attdata '(("DATA1" "Prompt1" "DefValue1")("DATA2" "Prompt2" "DefValue2")))
(setq wShapeDBfn "AISC_SHAPE_W.txt")
;; error function & Routine Exit
(defun *error* (msg)
(if (not (member msg '("console break" "Function cancelled" "quit / exit abort" "")))
(princ (strcat "\nError: " msg))
) ; endif
(and usrosmode (setvar "osmode" usrosmode))
(and usrormode (setvar "orthomode" usrormode))
(if (and MoveStarted Ins)
(command "._erase" Ins "")
)
)
;;parser by CAB single character delim, match ","
(defun sparser (str delim / ptr lst)
(while (setq ptr (vl-string-search delim str))
(setq lst (cons (substr str 1 ptr) lst))
(setq str (substr str (+ ptr 2)))
)
(reverse (cons str lst))
)
;;+++++++++++++++++++++++++++++++
;;convert the text to a number - CAB
;;+++++++++++++++++++++++++++++++
(defun txt2num (txt / num)
(or (setq num (distof txt 5))
(setq num (distof txt 2))
(setq num (distof txt 1))
(setq num (distof txt 4))
(setq num (distof txt 3))
)
num
)
(defun getdata (lst / nlst L sl sl2)
(foreach ln lst
(setq l (sparser ln "\t")
sl(car l)
l (cdr l)
sl2 nil
)
(if (/= "" (vl-string-trim " \t\n" sl)) ; skip blank lines
(progn
(foreach itm l (setq sl2 (cons (txt2num itm) sl2)))
(setq l (cons sl (reverse sl2)))
(setq nlst (cons l nlst))
)
)
)
nlst
)
(defun makedatabase (filename / path handle result stream)
(if (null wdatabase*)
(if (setq path (findfile filename))
(if (setq handle (open path "r"))
(progn
(while (setq stream (read-line handle))
(setq result (cons stream result))
)
(setq wdatabase* (getdata result))
(princ)
)
)
)
)
)
;;by CAB 10/05/2007
;;Expects pts to be a list of 2D or 3D point lists
;;Returns new pline object
(defun makepline (spc pts / norm elv pline)
(setq norm (trans '(0 0 1) 1 0 t)
elv(caddr (trans (car pts) 1 norm))
)
;;flatten the point list to 2d
(if (= (length (car pts)) 2) ; 2d point list
(setq pts (apply 'append pts))
(setq pts (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
)
(setq
pts (vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (1- (length pts))))
pts
)
)
)
(setq pline (vla-addlightweightpolyline spc pts))
(vla-put-elevation pline elv)
(vla-put-normal pline (vlax-3d-point norm))
(vla-put-closed pline :vlax-true)
(vla-put-layer pline "0")
;;(vla-put-Color PolObj AcYellow)
;;(vla-put-Linetype PolObj "HIDDEN")
pline
)
;; sname dep bf tw tf
;;("W12X16" 12.0 4.0 0.25 0.25 0.8125 0.5625)
(defun makewshape (space data attdata / att attdata atts bf blkdef bn d doc l1 l2 p1 p10
p11 p12 p13 p2 p3 p4 p5 p6 p7 p8 p9 plobj r tf tw x y)
(mapcar '(lambda (x y) (set x y)) '(bn d bf tf tw x y) data)
(if (tblsearch "block" bn) ; block exist
(vlax-invoke space 'insertblock (trans '(0. 0. 0.) 1 0) bn 1. 1. 1. 0.)
(progn
;; make the shape with pline, chamfer ILO arc at web
;; p2 is lower left point
;; radius at web is undifined by ASCI & left to the Manufactures
;; This shape uses 1/2 the web thickness (tw) for the chamfer
;; Chamfer points occur at p5 p6 p11 p12 so in place of p5 use
;;(vadd p5 (list 0. r)) (vadd p5 (list r 0.))
(defun vadd (v1 v2) (mapcar '+ v1 v2))
(setq p1'(0. 0.)
l1(/ bf 2.) ; 1/2 base
l2(- l1 (/ tw 2.))
r (/ tw 2.) ; chamfer value
p2(vadd p1 (list (- l1) 0.)) ; 0 = no change
p3(vadd p2 (list bf 0.))
p4(vadd p3 (list 0. tf))
p5(vadd p4 (list (- l2) 0.))
p6(vadd p5 (list 0. (- d (* tf 2))))
p7(vadd p6 (list l2 0.))
p8(vadd p7 (list 0. tf))
p9(vadd p8 (list (- bf) 0.))
p10 (vadd p9 (list 0. (- tf)))
p11 (vadd p10 (list l2 0.))
p12 (vadd p11 (list 0. (- (- d (* tf 2)))))
p13 (vadd p12 (list (- l2) 0.))
)
;;create the block def
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blkdef (vlax-invoke (vla-get-blocks doc) 'add '(0. 0. 0.) bn))
;; add attributes to BlockDef
;;AttData list of list with 3 strings'((TAG Prompt DefVal)("DATA1" "Prompt1" "DefValue1"))
(foreach itm attdata
(setq atts ; list of enames for the attribute Def
(cons
;;AddAttribute (Height, Mode,Prompt, InsertionPoint, Tag, Value)
;;(setq att (vla-AddAttribute blk 0.5 acAttributeModeInvisible (cadr itm) p1 (car itm) (caddr itm)))
(setq att (vlax-invoke blkdef 'addattribute 0.5 1 (cadr itm) '(0. 0. 0.) (car itm) (caddr itm)))
atts))
(vla-put-layer att "0")
) ; end foreach
;;chamfer added to web, pline obj added to BlockDef
(setq plobj (makepline blkdef (list p2 p3 p4
(vadd p5 (list r 0.)) (vadd p5 (list 0. r))
(vadd p6 (list 0. (- r)))(vadd p6 (list r 0.))
p7 p8 p9 p10
(vadd p11 (list (- r) 0.))(vadd p11 (list 0. (- r)))
(vadd p12 (list 0. r)) (vadd p12 (list (- r) 0.))
p13))) ; vla object
(vlax-invoke space 'insertblock (trans '(0. 0. 0.) 1 0) bn 1. 1. 1. 0.)
)
) ; endif
)
;;DCL routine for user to select shape from database
;;Returns the shape name i.e."W4X12"
(defun getuserpick (database picked / dclfile dcl# fn shapepick)
(setq fn "wShapes.dcl")
(cond
((not (setq dclfile (findfile fn))) (prompt (strcat "\nCannot find " fn ".")))
((=- -==- -==- -==- -==- -==- -==- -==-
;; Run the Dialog
;; -==- -==- -==- -==- -==- -==- -==- -==-
(defun doit (dcl_id data pick / action fulllst n pick)
(setq fulllst (mapcar 'car data)) ; list of only shape names
(start_list "shapelist")
(mapcar 'add_list fulllst)
(end_list)
;;Update filename display for list box
(action_tile "shapelist" "(setq pick (nth (atoi $value) fulllst))")
(if (setq n (vl-position pick fulllst))
(set_tile "shapelist" (itoa n))
(set_tile "shapelist" "0")
)
(action_tile "Insert" "(done_dialog 2)")
(action_tile "HelpDialog" "(done_dialog 5)")
(action_tile "Done" "(done_dialog 0)")
;;******************************************************
(setq action (start_dialog))
;;******************************************************
(cond
((= action 1) (setq pick null)) ; exit
((= action 2)) ; exit
((= action 5) (setq pick null)) ;
((setq pick null)) ; unknown code
)
(unload_dialog dcl_id)
pick
) ; end defun
;;This is my clumsy routine to move & rotate an Insert. It repeats with the same Block
;;until user hits Enter or Escape
(defun MoveBlock (obj spc lay / ins movestarted npt ormodetmp osmodetmp pt shape usrormode usrosmode bn)
(setq pt '(0 0))
(setq usrosmode (getvar "osmode")) ; reset when routine ends
(setq usroRmode (getvar "orthomode")) ; reset when routine ends
(setq osmodetmp (getvar "osmode")) ; temp setting
(setq ormodetmp (getvar "orthomode")) ; temp setting
(setq bn (vla-get-name obj))
;; (setvar "osmode" 0)
(while
(progn
(setq MoveStarted t)
;; (setvar "osmode" 0)
(setvar "orthomode" 0)
(setq Ins (vlax-vla-object->ename obj))
(vla-put-layer obj Lay) ; Layer of Insert
(command "._move" Ins "" pt)
;;(setvar "osmode" osmodetmp)
(command pause)
(if (or (and (null npt) (setq npt (getvar "lastpoint")))
(> (distance pt (setq npt (getvar "lastpoint"))) 0.001))
(progn
;;allow user to rotate
(setvar "osmode" osmodetmp)
(setvar "orthomode" 1)
(command "._rotate" Ins "" "_non" npt)
(command pause)
(setq MoveStarted nil)
(setq osmodetmp (getvar "osmode"))
(command "._undo" "_end")
(command "._undo" "_begin")
;;Add a new Insert
(setq obj (vlax-invoke spc 'insertblock (trans '(0. 0. 0.) 1 0) bn 1. 1. 1. 0.))
t ; stay in loop
)
)
)
) ; while
(*error* "")
(command "._undo" "_end")
(princ)
)
;;================================================================
;; Start of Routine
;;================================================================
(setq space
(if (= 1 (getvar "CVPORT"))
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
)
)
(or UserShapePick (setq UserShapePick "")) ; string = to 1st item in list "W4X12"
; (setq wdatabase* nil) ; debug
(cond
((not (or wdatabase* (makedatabase wShapeDBfn))) ; load database from text file
(princ "\nDatabase Failed to Load.")
)
((not (setq shape (getuserpick wdatabase* UserShapePick))) ; need user selection
(princ "\nUser Quit or Problem with DCL.")
)
((setq data (assoc shape wdatabase*))
;;got new shape
(setq UserShapePick shape)
;;make block if not in drawing
(setq InsBlk (makewshape space data attdata)) ; add block to DWG & Insert @ 0,0
(if insBlk ; move it into position
(MoveBlock InsBlk space InsLay)
)
)
((princ "\nUser Quit."))
)
(princ)
)
我刚刚使用了1/4 tw倒角ILO半径。至于半径，请参阅https://www.aisc.org/DynamicTaxonomyFAQs.aspx?id=1524 谢谢，也更改了我的副本。
Tim，
您有机会尝试Lisp吗？
我想你们都知道，HSS的形状属性是基于减少钢的厚度，以允许生产公差，所以他们的厚度值是理论值的97%左右。如果上面写着HSS 3x3x1/4”，那还不到1/4”。AISC表格考虑到了这一点。
你的积木是基于实际尺寸还是细节尺寸？出于起草的目的，我会投票赞成详细的尺寸。
我仍然手工绘制钢型材！当我思考我的详细布局并画出一系列可能有用的钢截面时，有一种特定的禅。当我画出几个部分的时候，我的脑子已经想好了什么该放在哪里。
但我愿意为你的计划而死。有人做了一个结构螺栓，我欠他们很多。一会儿感谢他，一会儿感谢你。
鲍勃 鲍勃，
谢谢你的提醒。我的用途是建筑结构中的偶尔部分，所以机器公差对我来说不是一个因素。
我也是手工绘制的，但兴奋感消失了，我用这个操作性来自动化这个过程。我现在不需要属性，但蒂姆这样做了，我包含了一些通用atts&一种简单的方法来定制它们。我想实际尺寸减少3%可以很容易地结合起来。尤其是如果它在所有测量上都是统一的。
我的用途是作为工程师的半智能绘图员。在房屋和木材等方面，我很有知识，但钢制构件是我仍在学习的领域。没有做足够的工作来保留，所以我在使用它时经常查找数据。工程师在他的铅笔草图中召唤成员&我必须查找细节。我想我接下来会添加矩形管。或者可能是铝工字梁。直到我度假回来（14-21），这才会发生。如果列表增加，也许是形状和类型的单选按钮或另一个选择列表。
只是漫无边际地说几句。
一个快速的谷歌和我看到的数据库为HSS广场和矩形部分是可用的
http://www.lisaed.com/hsssq.html
PS我将添加代码忽略分号在文本数据库文件，所以我可以添加一个标题。 感谢你们的努力，提姆和凯布。
Cab，我有最新版的铝协会手册，上面有所有最新的铝型材。如果你度假回来，你甚至还想坐在电脑前，那么你的假期就泡汤了——不，我想说的是，我会给你送任何你想要的铝材料。既然是为了教育用途，没有侵犯版权。
你假期做了什么？
鲍勃 鲍勃，
还没走。从8月14日到8月21日，我们将前往田纳西州罗恩山。
是的，如果可以的话，请把东西寄给我<我离开前可能有时间玩。今天又热又重&不过明天。
页:
[1]