Message 1 of 12
Allow end point selection during insert on this custom insert list command
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
So I have had this lisp for awhile and now adding "sound" to the lisp. I was able to add it just fine but when it inserts the block it doesn't allow you to use object snaps to be used. Is there a way to add it see full lisp below.
I think it has to do with this section of the code but not 100% sure. I don't need it to specifically only use object snap points because sometimes I just insert the blocks in open space. I really hope this can be done it will make it a lot easier put the legend together, rather than putting all the blocks in and then move them together afterwards. I have attached 2 drawings that the lisp can reference for the blocks.
(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_)
(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:ibTEST ( / 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"))
( ("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" "FDBZ492-HR DUCT 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"))
( ("MR-801T-LEGEND") ("HTRI SHUNT TRIP 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") ("SE-MC - SET-MC 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" "Brad's Nicet Block" "Darwins nicet stamp" "CABLE STIPPING DETAIL"))
( ("FC922-US -- LEGEND") ("FC922-US FULL PANEL -- RISER"))
( ("OSI-90 - LEGEND" "OSE-SPW - LEGEND") ("OSID-HTRI - DETAIL" "OSID-XTRI - DETAIL"))
( ("XTRI-S - LEGEND") ("XTRI-S DETAIL" "XTRI-S - PIV DETAIL"))
( ("SIGA-AA50 - LEGEND") ("AA30-AA50 - 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") ("SL SERIES HORN-STROBE - DETAIL"))
( ("SLSPSWR-F - LEGEND" "SLSPSWW-F - LEGEND" "SLSPSCW-F - LEGEND") ("SL SERIES SPEAKER-STROBE - 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" "XSERIES DUCT DETECTOR 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") ("Brad's Nicet Block" "Darwins nicet stamp" "CABLE STIPPING 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"))
( ("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")))
)
;; "AV" name list ;;
("SOUND LEGEND" (
( ("HD-TX-201-C-2G-E-B-T") ("HD-TX-201-C-2G-E-B-T - LEGEND"))
( ("HD-TX-101-C-1G-E-B-T") ("HD-TX-101-C-1G-E-B-T - LEGEND")))
)
;; "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)
