Need to edit this lisp to be able to insert blocks with a basepoint if I want to.

Need to edit this lisp to be able to insert blocks with a basepoint if I want to.

bgraverholt
Advocate Advocate
1,478 Views
6 Replies
Message 1 of 7

Need to edit this lisp to be able to insert blocks with a basepoint if I want to.

bgraverholt
Advocate
Advocate

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)

 

 

 

 

0 Likes
Accepted solutions (1)
1,479 Views
6 Replies
Replies (6)
Message 2 of 7

pbejse
Mentor
Mentor
Accepted solution

@bgraverholt wrote:

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. ..

 

 

 

 ":: Insert Detail From Legend Version 1.1 | pBe 2015 ::"

 

Feels like a long time ago,

I modified the code to take into account the osnap using  GrSnap by LeeMac <-- Download

Osnap mode will be 0 [ Non ] when "XLS" is selected and 239 [ End,Mid,Cen,Node,Inter,Ins,Perp ] for the rest.

 

 

(setvar 'osmode 239)

 

Added an *error* handler to restore osmode to its original state

Am thinking this code deserves a re-write and remove all the hbard coded list from the program.

 

HTH

 

Kudos to LeeMac for the cool GrSnap function 🙂

 

 

0 Likes
Message 3 of 7

bgraverholt
Advocate
Advocate

The changes you made does allow it to snap but it snaps the block to the basepoint of the selected blocks it doesn't let me choose a location. Also after it inserts the first block it ends the command. I didn't originally create this lisp I had some help from the forum 2-3 years ago so I only know how some things work with it but not a lot of it. So I assume its a placement of some code inside of it?

0 Likes
Message 4 of 7

pbejse
Mentor
Mentor

@bgraverholt wrote:

The changes you made does allow it to snap but it snaps the block to the basepoint of the selected blocks it doesn't let me choose a location. Also after it inserts the first block it ends the command


What part of the program are you referring to?  SOUND or  XLS?  can you please elaborate?

 

Not sure what you meant by that. I dont' see that behavior while running the program on the "example drawing.dwg"

Also, what part of the program are you referring to? 

 

 


@bgraverholt wrote:

I didn't originally create this lisp I had some help from the forum 2-3 years ago so I only know how some things work with it but not a lot of it. So I assume its a placement of some code inside of it?


 

Who better to modify the program than those who helped buid the code you think?  People just dont ask additional functionality out of the blue and expect it to be done immediately. A good 2 to 3 years had passed, I'm just hoping it helped the user during those times. and its all FREE

 

Lisp for inserting a blocks specific to a selection 

Allow end point selection during insert on this custom insert list command 

 

Now, would you be kind enough to explain the new requirements.

 

 

0 Likes
Message 5 of 7

bgraverholt
Advocate
Advocate

See attached screen cast for example of how it acts on my computer. I removed all lisps from my autocad already thinking it was part of the issue but that wasn't the case. 

 

Who better to modify the program than those who helped buid the code you think?  People just dont ask additional functionality out of the blue and expect it to be done immediately. A good 2 to 3 years had passed, I'm just hoping it helped the user during those times. and its all FREE

 

-I would have but I figured this would just be a small change to the lisp to add this feature so I decided I would try and see if someone could help add it for me before going back  and trying to find the original post. It has been very useful over the years now I am trying to find a way to make it even more useful.

 

0 Likes
Message 6 of 7

pbejse
Mentor
Mentor

Did you or did you not load the function from the link i posted ? [ post # 2 ]

--------------------------------------------------------------------------------------------------

I modified the code to take into account the osnap using  GrSnap by LeeMac <-- Download

--------------------------------------------------------------------------------------------------

Please pay attention to the posts  @bgraverholt 

The attached lisp will also include the "missing" functions upon loading

 

0 Likes
Message 7 of 7

bgraverholt
Advocate
Advocate

Totally misunderstood your message. After adding GRSnap lisp to autocad it works perfectly! Thank you so much for your help. Now all I have to do is create the Sound block list haha!

 

0 Likes