Tim,
You may want to give this a try. Just some code I threw together to use your text file as a database.
DCL file attached
;;;====================================================================;
;;; wShapes.lsp ;
;;; Revision 1.3 08/03/14 ;
;;; Charles Alan Butler ;
;;; TheSwamp.org ;
;;; @ Copyright 2014 ;
;;;====================================================================;
;;;
;;; ASCI Steel W shapes, end view, using a data text file ""
;;; The routine offers the user a DCl pick list to choose a W Steel Shape
;;; and adds that shape to the drawing as a block with two hidden attributes.
;;; You may modify the attribute creation by editing the setq attdata line
;;; below. The Layer of the Insert is also found below with variable InsLay.
;;; Currently set to "0" No layer check is made at this time. If the block
;;; already exist it is simply inserted. The user picks insert point and
;;; then rotation.
;;;
;;;====================================================================;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;;====================================================================;
;;; Copyright 2014 by Charles Alan Butler. All Rights Reserved. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;; ;
;;; Copying, modification and distribution of this software or any ;
;;; part thereof in any form except as expressly provided herein is ;
;;; prohibited without the prior written consent of Charles Alan ;
;;; Butler, 1403 Duelda Drive, Brandon Florida, 33511 ;
;;; ;
;;;====================================================================;
;;================================================================
;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;================================================================
(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 ".")))
((< (setq dcl# (load_dialog dclfile)) 0) (prompt (strcat "\nCannot load " fn ".")))
((not (new_dialog "shapesdialog" dcl#)) (prompt (strcat "\nProblem with " fn ".")))
((setq shapepick (doit dcl# database picked)) ; No DCL problems: fire it up
;; returns the shape name or nil
)
) ; end cond
)
;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;; 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)
)