- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
The lisp I have below inserts blocks that I associate them with. The section I need help with is the SOUND list. See Screencast for an example of what the IB Lisp does. So for the sound insert list I would like to be able to insert the legend blocks that come in with a object snap point. I have my object snaps on but when running the lisp it wont let me select an object snap point. On a side note I don't want it to be stuck to only inserting the block to an endpoint because as you can see when I insert blocks for the XLS list blocks I don't need or want to insert it to a specific object snap point. I just want place the blocks where ever there is space in the drawing. I really hope there is a way to do this be a pain to insert them and then move them to line up all the time. I have attached the drawing that was in the screen cast and the 2 drawings the lisp will reference to insert the blocks.
(defun ibMain ( Det_ lst / adoc space lst leg vleg bn blk ipoint dbx blkdbx AllData )
;;; pBe 20 March 2015 ;;;
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
space (vlax-get (vla-get-ActiveLayout adoc) 'Block))
(if (setq AllData nil ss (ssget (list (cons 2 (strcat (apply 'strcat
(mapcar '(lambda (nme)
(strcat nme ","))
(apply 'append (setq leg (mapcar 'car lst))))) "`*U*")
))))
(progn
(repeat (setq i (sslength ss))
(setq en (ssname ss (Setq i (1- i))))
(if (member (setq bn (vla-get-effectivename (vlax-ename->vla-object en))) (apply 'append (mapcar 'car lst)))
(setq AllData (cons (list bn (cdr (assoc 10 (entget en))))
;;; (mapcar '(lambda (d)
;;; (cdr (assoc d (entget en))))
;;; '(2 10))
AllData)
)
)
)
;; Selection Sorted from Top to Bottom ;;
(setq AllData (vl-sort AllData '(lambda (dt dt2) (> (cadadr dt)(cadadr dt2)))))
;; ;;
(foreach data AllData
(if (setq vleg (vl-some '(lambda (nm_)
(if (member (Car data) nm_)
nm_)) leg))
(foreach det (cadr (assoc vleg lst))
(if (setq bn (_BlockExist det det_ ))
(progn
(Setq obj (vlax-invoke space 'InsertBlock (cadr data)
bn 1 1 1 0))
;;;(vla-put-layer obj "0") to change layer to certain layer removed to keep current layer active
(moveTo obj (cadr data))
(redraw)
)
(princ "\n<<< Detail Not Found >>>")
)
)
)
(setq leg (vl-remove vleg leg))
)
)
(princ "\n<<< Block Legend Detail not found >>>")
)
(princ)
(command "-purge" "blocks" "" "n")
)
(defun MoveTo ( e pt / gr )
;;; pBe 20 March 2015 ;;;
(setq pt_ pt)
(progn
(princ "\nPick insertion point: ")
(while (= 5 (car (setq gr (grread t 13 0))))
(redraw)
(vlax-invoke e 'Move pt (cadr gr))
(grdraw pt_ (cadr gr) 1 -1)
(setq pt (cadr gr))
)
)
;;; Remove the lines below | For testing purposes only ;;;
;;; (entmakex (list (cons 0 "LINE")
;;; (cons 10 pt_)
;;; (cons 11 pt)))
;;; Remove The Lines above | For testing purposes only ;;;
)
(defun _BlockExist (bn_ de_ / indfile f flst chk)
;;; pBe 20 March 2015 ;;;
(setq flst nil)
(cond
;;; Current drawing session ;;;
((or (and (tblsearch "BLOCK" de_)
(tblsearch "BLOCK" bn_))
(tblsearch "BLOCK" bn_)
)
bn_
)
;;; Block saved as individual file within SFSP ;;;
((setq indfile (findfile (strcat bn_ ".dwg"))) indfile)
;;; if found, copy listed blocks from ;;;
;;; "XLS DETAILS.dwg" will only run once per ;;;
;; session if other conditions evaluates to nil ;;;
((setq f (findfile (strcat de_ ".dwg")))
(setq chk (i:openDBXDoc f))
(foreach itm (apply 'append (mapcar 'cadr lst))
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ()
(setq blkdbx (vla-item (vla-get-blocks chk) itm))
)
)
)
)
)
(progn
(setq flst (cons itm flst))
(vla-copyobjects
chk
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject '(0 . 0))
(list blkdbx)
)
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
)
)
)
(setq chk (i:CloseDBXDoc chk))
(if (member bn_ flst) bn_)
)
)
)
;;; ODBX Functions Robert Bell ;;;
(defun i:IsReadOnly (fileName / fileH)
(cond ((setq fileH (open filename "a"))
(close fileH))
((not fileH))))
(defun i:CloseDBXDoc (dbxDoc)
(vl-catch-all-apply 'vlax-Release-Object (list dbxDoc))
(setq dbdDoc nil)
)
(defun i:OpenDBXDoc (fileName / newFile dbxDoc chkOpen)
(cond ((or (i:IsReadOnly fileName)
(= (strcase (vl-filename-extension filename))
".DWT"))
(setq newFile (vl-filename-mktemp "Temp .dwg"))
(vl-file-copy fileName newFile)))
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbxDoc (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbxDoc (vlax-create-object
(strcat "ObjectDBX.AxDbDocument."
(substr (getvar "ACADVER") 1 2)
)
)
)
)
(setq chkOpen
(vl-catch-all-apply
'vla-Open
(list dbxDoc
(cond (newFile)
(fileName)))))
(cond ((vl-catch-all-error-p chkOpen)
(vlax-Release-Object dbxDoc)
nil)
(dbxDoc)))
;; --End of ODBX Functions : Robert Bell-- ;;;
;;; THIS IS SECTION OF THE CODE WHERE YOU ADD ;;;
;;; SYSTEM AND NAME LIST FOR LEGEND & DETAILS ;;;
(defun c:ib ( / lst System SysData NameList)
;; pBe 20 March 2015 ;;;
;;; This is where you add the a New System ;;;
;;; & Name list ;;;
;;; FORMAT: ("SYSTEM NAME" ( ;;;
;;; ( ("LN1" "LN2") ;<--One or more LEGEND ;;;
;;; ("D1" "D2"))) ;<--One or more DETAIL ;;;
(setq NameList
;; "XLS DETAILS"" name list ;;
'(
("XLS DETAILS" (
( ("OP921-DB-11 -- LEGEND" "OOH941-DB-11 - LEGEND" "OOH941-DB-11" "HI921-DB-11" "FP-11 - DB-11") ("SMOKE AND HEAT TYPICAL DETAIL"))
( ("AS-75-R-WP") ("AS-75-R-WP DETAIL"))
( ("HI921 - DB2-HR - LEGEND" "OP921-DB2-HR - LEGEND") ("OOH941-HI921- DB2-HR"))
( ("HTRI-D-LEGEND") ("HTRI-D WATER FLOW AND TAMPER" "HTRI-D BASIC DETAIL"))
( ("HTRI-S-LEGEND") ("HTRI-S-DETAIL" "HTRI-S - PIV WIRING DETAIL"))
( ("PAD-3 -- LEGEND") ("PAD-3 - DETAIL" "PAD-- RESISTOR -- DETAIL"))
( ("PAD-4-6A-LEGEND") ("PAD-4-6A-DETAIL" "PAD-- RESISTOR -- DETAIL"))
( ("PAD-4-9A -- LEGEND") ("PAD-4-9A-DETAIL" "PAD-- RESISTOR -- DETAIL"))
( ("PAD-5-9A -- LEGEND") ("PAD-5-9A - DETAIL" "PAD-- RESISTOR -- DETAIL"))
( ("HTRI-R-LEGEND") ("HTRI-R-DETAIL"))
( ("HMS-D-LEGEND" ) ("HMS-D-DETAIL" ))
( ("HCP -- LEGEND") ("HCP WIRING DETAIL"))
( ("FDBZ492 - OP921 - ST-50" "RSM-2" "RL-HW - LEGEND") ("FDBZ492 - RSM-2 - HTRI-R - RL-HW" "FDBZ492-HR DUCT MOUNTING DETAIL"))
( ("FDBZ492-HR - OP921 - ST-50 - DAMPER DUCT LEGEND") ("FDBZ492-HR DAMPER DUCT DETAIL" "DAMPER SMOKE DETECTOR MOUNTING DETAIL" "XSERIES DAMPER DUCT DETECTOR DETAIL"))
( ("FDBZ492-HR - OP921 - ST-50 LEGEND" "FDBZ492-RTL -- LEGEND") ("FDBZ492-HR WITH HTRI-R AND FDBZ492-RTL - DETAIL" "FDBZ492-HR DUCT MOUNTING DETAIL"))
( ("FDBZ492 - OP921 - ST-50 - DAMPER DUCT - X SERIES LEGEND") ("FDBZ492 DAMPER WITH XTRI-R - DETAIL" "DAMPER SMOKE DETECTOR MOUNTING DETAIL"))
( ("FDBZ492 - OP921 - ST-50 - X SERIES - LEGEND") ("FDBZ492 DUCT WITH XTRI-R - DETAIL" "FDBZ492-HR DUCT MOUNTING DETAIL"))
( ("FDBZ492-HR - OP921 - ST-50 - X SERIES - LEGEND") ("FDBZ492-HR X SERIES - DETAIL" "FDBZ492-HR DUCT MOUNTING DETAIL"))
( ("FDBZ492-HR - OP921 - ST-50 - DAMPER DUCT - X SERIES - LEGEND") ("FDBZ492-HR DAMPER DUCT X SERIES DETAIL" "DAMPER SMOKE DETECTOR MOUNTING DETAIL"))
( ("MR-801T-LEGEND") ("HTRI SHUNT TRIP DETAIL"))
( ("FT2015-U3 - LEGEND")("FT2015-U3 - DETAIL"))
( ("HTRI-M - LEGEND") ("HTRI-M DETAIL"))
( ("MB-G10-24-R - LEGEND") ("QUAD MODULE WITH W-F AND BELL"))
( ("SEC-W -- LEGEND") ("SEC-W - DETAIL"))
( ("RSS-24MCW-ALW - LEGEND") ("RSS SERIES STROBE - DETAIL"))
( ("E50-24MCW-ALW - LEGEND" "E-50 - LEGEND") ("E-50 SERIES SPEAKER WIRING DIAGRAM - DETAIL"))
( ("MS-151") ("MS-151-DETAIL"))
( ("HMS-S - LEGEND") ("HMS-S - DETAIL"))
( ("FC922-UT - LEGEND") ("FC922-UT - RISER"))
( ("FC901-U3 -- LEGEND") ("FC901-U3 -- DETAIL" "FC901-U3 BACKBOX DETAIL"))
( ("HZM-LEGEND") ("HZM-BEAM DETECTOR"))
( ("SET-185-R-WP -- LEGEND" "SE-MC-W -- LEGEND" "SET-MC-CW -- LEGEND" "SET-MC-R -- LEGEND" "SET-S17-R-WP" "SE-MC-R -- LEGEND" "SE-MC-CR - LEGEND" "SE-MC-CW -- LEGEND" "SEH-HMC-W - LEGEND" "SEH-HMC-CW - LEGEND") ("SE-MC - SET-MC - SEH-HMC SPEAKER STROBE"))
( ("ZR-MC-CW" "ZR-MC-R" "ZH-HMC-R - LEGEND" "ZR-HMC-CW - LEGEND" "ZR-HMC-R" "ZR-MC-CR - LEGEND" "ZH-MC-R-LEGEND" "ZH-MC-W -- LEGEND" "ZH-MC-CR - LEGEND" "ZH-MC-CW - LEGEND" "ZH-HMC-CW - LEGEND" "ZH-HMC-CR - LEGEND" "ZH-MC-W-LEGEND" "ZR-MC-W-LEGEND") ("ZR-MC - ZH-MC - ZR-HMC"))
( ("FDCI0422 -- LEGEND") ("FDCIO422 QUAD MODULE - TAMPER AND FLOW DETAIL" "FDCIO422 SHUNT TRIP ELEVATOR DETAIL" "FDCIO422 QUAD MODULE - FIRE PUMP DETAIL" "FDCIO422 - DETAIL"))
( ("OP921-ABHW-4B -- LEGEND") ("OP921-ABHW-4B -- DETAIL"))
( ("OOHC941-ABHW-4B - LEGEND") ("OP921-ABHW-4B -- DETAIL"))
( ("FIRE ALARM DEVICE LEGEND HEADING") ("DEVICE MOUNTING LOCATION DETAIL" "NICET STAMP" "CABLE STRIPPING DETAIL"))
( ("FC922-US -- LEGEND") ("FC922-US FULL PANEL -- RISER"))
( ("OOHC941-ABHW-4S - LEGEND") ("OP921-ABHW-4S -- DETAIL"))
( ("OSI-90 - LEGEND" "OSE-SPW - LEGEND") ("OSID-HTRI - DETAIL" "OSID-XTRI - DETAIL"))
( ("SLFSSWR-F - LEGEND") ("SLFSS WALL BACK BOX DETAIL" "SLFSSWR-F - DETAIL"))
( ("XTRI-S - LEGEND") ("XTRI-S DETAIL" "XTRI-S - PIV DETAIL"))
( ("SIGA-AA50 - LEGEND") ("AA30-AA50 - DETAIL"))
( ("ILED-XW - LEGEND") ("ILED-XW - DETAIL"))
( ("XMS-D - LEGEND") ("XMS-D - DETAIL"))
( ("XMS-S - LEGEND") ("XMS-S - DETAIL"))
( ("XTRI-D - LEGEND") ("XTRI-D WATER FLOW AND TAMPER"))
( ("XTRI-R - LEGEND") ("XTRI-R DETAIL" "XTRI-R SHUNT TRIP DETAIL"))
( ("SLHSWW-F - LEGEND" "SLHSCR-F - LEGEND" "SLSCR-F - LEGEND" "SLSCW-F - LEGEND" "SLSWW-F - LEGEND" "SLHSWR-F - LEGEND" "SLSWR-F - LEGEND" "SLHSCW-F - LEGEND" "SLHWW-N - LEGEND" "SLFSWR-F - LEGEND" "SLFSWW-F - LEGEND") ("SL SERIES HORN-STROBE - DETAIL"))
( ("SLSPSWR-F - LEGEND" "SLSPSWW-F - LEGEND" "SLSPSCW-F - LEGEND") ("SL SERIES SPEAKER-STROBE - DETAIL" "SLSP WALL BACK BOX DETAIL"))
( ("XTRI-M - LEGEND") ("XTRI-M DETAIL"))
( ("FC924-UT - LEGEND") ("FC924-UT - RISER"))
( ("OP921-ABHW-4S - LEGEND") ("ABHW-4S - DETAIL"))
( ("MBDC-6 - LEGEND") ("MBDC-6 - DETAIL"))
( ("SLSPCW-F - LEGEND") ("SL SERIES SPEAKER WIRING DETAIL"))
( ("LSPSTRC3 - LEGEND" "LSPSTR3 - LEGEND") ("EXCEDER SPEAKER STROBE - DETAIL"))
( ("LSTR3 - LEGEND" "LSTRC3 - LEGEND" "LHSR3 - LEGEND") ("EXCEDER STROBE - DETAIL"))
( ("TSM-1X - LEGEND") ("TSM-1X DETAIL"))
( ("Legend 1") ("bananaitlog"))
( ("MTH-MC-R") ( "BANANACAKE" )))
)
;; "EDWARDS DETAIL" name list ;;
("EDWARDS DETAIL" (
( ("SIGA-CC1S-LEGEND") ("SIGA - CC1S"))
( ("FPD-7024 - LEGEND") ("FPD-7024 - DETAIL" "FPD-7024 BACKBOX - DETAIL"))
( ("FPP-RNAC-8A-4C - LEGEND") ("FPP-RNAC-8A-4C - DETAIL"))
( ("D282A-D280A SMOKE - LEGEND") ("D280A - DETAIL"))
( ("HSR - LEGEND" "STR - LEGEND") ("HSR-STR - DETAIL"))
( ("G1F-VM - LEGEND") ("G1F-VM"))
( ("SIGA-CT1-LEGEND") ("SIGA-CT1-DETAIL" "SHUNT TRIP POWER SUPERVISION-CONTROL"))
( ("SIGA-CR-LEGEND") ("SICA-CR-DETAIL" "SIGA-CR--DAMPER RELAY HIGH VOLTAGE DETAIL" "SIGA-CR--DAMPER RELAY LOW VOLTAGE DETAIL" ))
( ("SIGA-CT2-LEGEND") ("SIGA-CT2-DETAIL"))
( ("SIGA-COD - SIGA-AB4G - LEGEND") ("SIGA-AB4G AUDIBLE BASE - DETAIL"))
( ("SIGA-SD - SD-T60 DAMPER DUCT" "SD-TRK-LEGEND") ("SIGA-SD -- DAMPER DUCT DETAIL" "DUCT DETECTOR MOUNTING DETAIL"))
( ("SIGA-SD - SD-T60" "SD-TRM LEGEND") ("SIGA-SD TYPICAL DETAIL" "DUCT DETECTOR MOUNTING DETAIL"))
( ("BPS6A-LEGEND") ("BPS6A - DETAIL" "BPS6A-CR - DETAIL" "BPS6A RESISTOR - DETAIL" "BPS6A BASIC - DETAIL"))
( ("BPS10A-LEGEND") ("BPS10A - DETAIL" "BPS10A-CR - DETAIL" "BPS6A RESISTOR - DETAIL"))
( ("757-8A-T - LEGEND") ("757-8A-T - DETAIL"))
( ("G1RF-HDVM" "G1RF-VM" "G1F-HDVM" "G4LFRF-HVM - LEGEND" "G4LFWF-HVM - LEGEND") ("G1RF MOUNTING DETAIL." "G1F-HDVM - G1F-HDVM"))
( ("GCF-VM -- LEGEND" "GCF-HDVM -- LEGEND") ("GCF-VM - DETAIL"))
( ("SIGA-HRD-SIGA-SB4 - LEGEND" "SIGA-HFS-SIGA-SB4 - LEGEND" "SIGA-PD-SIGA-SB4 -- LEGEND") ("SIGA-PD--HRD - SIGA-SB4 -- DETAIL"));;;;;
( ("SIGA-HRD-SIGA-RB4 -- LEGEND" "SIGA-PD-SIGA-RB4 -- LEGEND") ("SIGA-PD-HRD - SIGA-RB4 -- DETAIL"));;;;;
( ("SIGA-278") ("SIGA-278 - DETAIL"))
( ("SIGA-LED - LEGEND") ("SIGA-SD WITH LAMP TYPICAL DETAIL"))
( ("G4HFWF-S7VMC -- LEGEND" "WG4WA-SVMC -- LEGEND") ("G4HFWF-WG4WA -- DETAIL" "G4HFWF-S7VMC -- BOX DETAIL"))
( ("SIGA-AA50 - LEGEND" "APS6A - LEGEND") ("APS6A - DETAIL"))
( ("GCF-S7VMH - LEGEND" "G4RF-S7VM -- LEGEND" "GCF-S7VM - LEGEND") ("GCF-S7VM -- G4F-S7VM -- G4F-S7VMH DETAIL"))
( ("SIGA-270-LEGEND") ("SIGA-270-DETAIL"))
( ("FIRE ALARM DEVICE LEGEND HEADING") ("NICET STAMP" "CABLE STRIPPING DETAIL"))
( ("ANS25MDG2 -- LEGEND") ("ANS25-50-100 -- DETAIL"))
( ("PIV - WATERFLOW - TAMPER") ("SIGA-CT2 WITH WATERFLOW & TAMPER" "SIGA-CT1 WITH PIV"))
( ("IO1000GD -- LEGEND") ("IO1000GD - RISER")))
)
;; "NURSE CALL" name list ;;
("NURSE CALL DETAIL" (
( ("HC-CONSOLE-3K - LEGEND") ("HC-CONSOLE - DETAIL"))
( ("HC-CL2-3K - LEGEND") ("HC-CL2-3K - DETAIL"))
( ("HC-CCSTN-3K - LEGEND") ("HC-CCSTN-3K - DETAIL"))
( ("HC-PB3-CANCEL -REMOTE CANCEL - LEGEND") ("HC-PB3-CANCEL -REMOTE CANCEL- DETAIL"))
( ("HC-PB3-CANCEL -PUSH BUTTON- LEGEND") ("HC-PB3-CANCEL -PUSH BUTTON- DETAIL"))
( ("HC-PP2-LAV-3K - LEGEND" "HC-PP2-LAV-3K WEATHER PROOF - LEGEND") ("HC-PP2-LAV-3K - DETAIL"))
( ("HC-CL4 - LEGEND") ("HC-CL4 - DETAIL"))
( ("HC-VSTN - LEGEND") ("HC-VSTN - DETAIL"))
( ("NGGTWY2-H - LEGEND") ("NGGTWY2-H - RISER"))
( ("HC-IPSWITCH8 - LEGEND") ("HC-IPSWITCH8 - RISER"))
( ("HC-DUTY-3K - LEGEND") ("HC-DUTY-3K - DETAIL"))
( ("LVC-3000-001 - LEGEND") ("LVC-3000-100 - DETAIL"))
( ("NGTDSP-H - LEGEND") ("NGTDSP-H - RISER"))
( ("LEGEND HEADER - NURSE CALL") ("RJ-45 PINOUT - DETAIL"))
( ("HC-PB2-CODE-3K - LEGEND") ("HC-PB2-CODE-3K - DETAIL"))
( ("HC-PB2-EMERG - LEGEND") ("HC-PB2-EMERG - DETAIL"))
( ("HC-AUX2-3K - LEGEND") ("HC-AUX2-3K - DETAIL"))
( ("SF117-2C - LEGEND") ("SF117-2C - DETAIL"))
( ("1212-WPS - LEGEND") ("1212-WPS - DETAIL"))
( ("HC-PSTN1-BED - LEGEND" "HC-PSTN2-BED - LEGEND") ("HC-PSTN1-HC-PSTN2 - DETAIL"))
( ("VER-2407 - LEGEND" "VER-2037 - LEGEND" "VER-4432 - LEGEND" "VER-4452 - LEGEND") ("IR TRACKING WIRING DETAIL" "TYPICAL IR SENSOR WIRING DETAIL")))
)
;; "SOUND LEGEND" name list ;;
("SOUND LEGEND" (
( ("DM-RMC-4KZ-SCALER-C") ("DM-RMC-4KZ-SCALER-C - LEGEND"))
(("TSW-560-B-S 760 1060")("TSW-760-B OR 1060-B - LEGEND"))
( ("VER-2407 - LEGEND" "VER-2037 - LEGEND" "VER-4432 - LEGEND" "VER-4452 - LEGEND") ("X")))
)
;; "xxxxxxx" name list ;; AKA NAME OF FILE
;;;
;;; ("SYSTEM NAME" (
;;; ( ("LEGEND") ("DETAIL"))
;;; ( ("LEGEND") ("DETAIL" "DETAIL"))
;;; ( ("LEGEND" "LEGEND") ("DETAIL")))
;;; )
;;;
;; "xxxxxxx" name list ;;
)
)
;;; ---End of Previous Comment--- ;;;
;;; This is where you add the System name ;;;
;;; Note: Only the ONE word of the filename ;;;
;;; Example "EDWARDS DETAIL" as "EDWARDS" ;;;
;;; Example "OTHER STUFF" as "STUFF" ;;;
;;; (initget "XLS EDWARDS STUFF") ;;;
;;; Example "EMERSONS DETAILS" as "eMerson" ;;;
;;; (initget "XLS EDWARDS eMerson")<-- "M" ;;;
;;; "E" already in use for EDWARDS ;;;
;;; "\nChoos System [XLS/Edwards/eMerson]: " ;;;
(initget "XLS EDWARDS NURSE SOUND")
;;; ---End of Previous Comment--- ;;;
(setq System (cond ( (getkword "\nChoose System [XLS/Edwards/Nurse/SOUND] <XLS>: ") ) ( "XLS" )))
(setq SysData (vl-some
'(lambda (b)
(if (wcmatch b (strcase (strcat "*" system "*")))
b))
(mapcar 'car NameList))
SysData (assoc SysData NameList))
(ibMain (car SysData) (cadr SysData))
)
(vl-load-com)
(princ
(strcat
"\n:: Insert Detail From Legend Version 1.1 | pBe 2015 ::"
"\n:: Type \"IB\" to Invoke ::"
)
)
(princ)
Solved! Go to Solution.