I am creating an unamed group is the program below, but when I run the group command and select "Include Unamed" it does not exist. If I (dictsearch) it, it doesn't apear to be there though it is a group. If I copy the opject the copies do show as unamed groups. am I doing something wrong entmake ing this group?
Thanks all
PS The code is used to creat JSI joists for floor framing, it uses a wipeout to hide the Xrefed foundation. I use Float.lsp to control the draworder of the objects.
;;; ------------------------------------------------------------------------
;;; IJoist.lsp v1.0
;;;
;;; Copyright © October, 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.
;;;
;;; IJoist:
;;; This program is used to create IJoist framed joists in the plan view.
;;;
;;; -----------------------------------------------------------------------
;;; ------------ COMMAND LINE FUNCTIONS
(defun C:IJOIST (/)(START_IJOIST))
;;; ------------ MAIN FUNCTION
(defun START_IJOIST (/
*error*
ActiveDoc
OldClayer
OldCmdEcho
EntRec
Point1
Point2
Point3
Point4
Point5
Point6
Point7
Point8
JList
SArray
vlaRec
WebList
SS
SSEntList
)
;;; 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)
)
(princ)
)
;;; End Error Handler ---------------------------------------------------
(IJOIST_SET_ENV)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun IJOIST_SET_ENV(/)
(setq OldClayer (getvar "CLAYER"))
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldCeLtype (getvar "CELTYPE"))
(setq OldCeColor (getvar "CECOLOR"))
(setvar "CMDECHO" 0)
(command "undo" "begin")
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= (getvar "cvport") 1)
(vla-get-paperspace ActiveDoc)
(vla-get-modelspace ActiveDoc)
)
)
;; Create wall
(MAKE_IJOIST)
)
;;; ------------ SET ENVIROMENT BEFORE LAUNCH
(defun MAKE_IJOIST (/)
;; Create and set layer for I-Joist
(IJOIST_CREATE_LAYER "A-FLOR-JSTS" "Floor josit framing members" "Continuous" "50" "93" "1")
(setvar "CLAYER" "A-FLOR-JSTS")
;; Create I-Joist
(setq Point1 (getpoint "Enter first point: "))
(setq JList (cons (list (car Point1) (cadr Point1)) JList))
(setq Point2 (getpoint Point1 "\nNext point: "))
(setq JList (cons (list (car Point2) (cadr Point2)) JList))
(setq Point3 (polar Point2 (+ (angle Point1 Point2) (/ pi 2))2.5))
(setq JList (cons (list (car Point3) (cadr Point3)) JList))
(setq Point4 (polar Point1 (+ (angle Point1 Point2) (/ pi 2))2.5))
(setq JList (cons (list (car Point4) (cadr Point4)) JList))
(setq JList (apply 'append JList))
(setq vlaRec (vla-addLightweightPolyline Space
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble (cons 0 (- (length JList) 1)))
JList))
)
(vla-put-closed vlaRec :vlax-true)
;; Get entname of rectangle for wipeout
(setq EntRec (cdr(car(entget(entlast)))))
(command "wipeout" "P" EntRec "Yes")
;; Create selection sets
(setq SS (ssadd (cdr(car(entget(entlast))))))
(setq SSEntList (list(cdr(car(entget(entlast))))))
;; Set layer & color for web
(if (tblsearch "ltype" "Dashed2")
(setvar "CELTYPE" "Dashed2")
(command "-linetype" "load" "dashed2" "" "set" "dashed2" "")
)
(setvar "CECOLOR" "8")
;; Create I-Joist webbing
(setq Point5 (polar Point1 (+ (angle Point1 Point2) (/ pi 2))1.0625))
(setq WebList (cons (list (car Point5) (cadr Point5)) WebList))
(setq Point6 (polar Point2 (+ (angle Point1 Point2) (/ pi 2))1.0625))
(setq WebList (cons (list (car Point6) (cadr Point6)) WebList))
(setq Point7 (polar Point6 (+ (angle Point1 Point2) (/ pi 2))0.375))
(setq WebList (cons (list (car Point7) (cadr Point7)) WebList))
(setq Point8 (polar Point5 (+ (angle Point1 Point2) (/ pi 2))0.375))
(setq WebList (cons (list (car Point8) (cadr Point8)) WebList))
(setq WebList (apply 'append WebList))
(setq vlaRec (vla-addLightweightPolyline Space
(vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble (cons 0 (- (length WebList) 1)))
WebList))
)
(vla-put-closed vlaRec :vlax-true)
;; Add to the selection sets
(setq SS (ssadd (cdr(car(entget(entlast)))) SS))
(setq SSEntList (cons(cdr(car(entget(entlast)))) SSEntList))
;; Create group for I joist
(CREATE_GROUP SSEntList)
(IJOIST_RESET_ENV)
)
;;; ------------ CREATES UNAMED GROUP
(defun CREATE_GROUP (SSList / GroupDictEname EntList)
(setq GroupDictEname (cdar (dictsearch (namedobjdict) "ACAD_GROUP")))
(setq EntList
(append
(list
'(0 . "GROUP")
'(102 . "{ACAD_REACTORS")
(cons 330 GroupDictEname)
'(102 . "}")
'(100 . "AcDbGroup")
'(300 . "I joist") ; Description
'(70 . 1) ; Named Group
'(71 . 1) ; Selectable Group
)
(mapcar '(lambda (Ent) (cons 340 Ent)) SSList);; Add all ent from SSList to the group
)
)
(entmake EntList)
)
;;; ------------ LAYER CREATION ROUINE
(defun IJOIST_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList Linetype)
;; Check to see if linetype exsists
(if (= (tblsearch "ltype" Linetype) nil)
(if (IJOIST_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)
)
)
)
;;; ------------ CHECKS TO SEE IF A LINETYPE IS AVAILIBLE
(defun IJOIST_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))
)
;;; ------------ RESET SYSEM VARIABLES
(defun IJOIST_RESET_ENV (/)
(command "undo" "end")
(setvar "CMDECHO" OldCmdEcho)
(setvar "CLAYER" OldClayer)
(setvar "CELTYPE" OldCeLtype)
(setvar "CECOLOR" OldCeColor)
(princ)
)
