home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 10.img / REGION1.LIB / WBLKSOL.LSP < prev   
Encoding:
Text File  |  1993-02-08  |  13.7 KB  |  439 lines
  1. ;;;   WBLKSOL.lsp
  2. ;;;   ¬⌐┼v (C) 1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  5. ;;;   ¡∞½h :
  6. ;;;
  7. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  8. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  9. ;;;
  10. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  11. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  12. ;;;
  13. ;;;
  14. ;;;   By Rick Barrientos
  15. ;;;   Thanks to Rajiv Jain for providing technical support.
  16. ;;;   Version 0.6               20 April 1992
  17. ;;;
  18. ;;;----------------------------------------------------------------------------;
  19. ;;;
  20. ;;;   DESCRIPTION
  21. ;;;
  22. ;;;   WBLKSOL.lsp is a sample AME 2.0 lisp routine.
  23. ;;;
  24. ;;;   It allows the user to WBLOCK a solid without losing the entity
  25. ;;;   handles. Normaly, if the WBLOCK command is used on a solid, the
  26. ;;;   entity handles are lost and the solid loses all its information.
  27. ;;;
  28. ;;;   This program uses a cheap trick to get around this problem.
  29. ;;;   The * option in WBLOCK will keep the entity handles, however
  30. ;;;   it also writes out everything in the drawing. WBLKSOL temporarily
  31. ;;;   deletes everything in the drawing except what the user selects to
  32. ;;;   write to a file. In this way the handles are kept intact.
  33. ;;;
  34. ;;;   This program is designed to work just like WBLOCK. All the
  35. ;;;   prompts are the same. The only exception is that the user can not
  36. ;;;   enter the name of a block, the solid must be selected by pointing
  37. ;;;   to it.
  38. ;;;
  39. ;;;   Revison 0.5 has added a new function to this file, The command
  40. ;;;   INSRTSOL.   The normal Autocad INSERT commnad can not be
  41. ;;;   used reliably with AME. It's use can result in bad handles.
  42. ;;;   This function automates the XREF and EXPLODE procedure that
  43. ;;;   is recommended for solid block insertion.
  44. ;;;
  45. ;;;   INSRTSOL is designed to work like the normal AutoCAD insert
  46. ;;;   command, it prompts for an insertion point and rotation. It
  47. ;;;   also checks if the specified block name is already defined
  48. ;;;   within the drawing and allows it's insertion.
  49. ;;;
  50. ;;;   Revision 0.6 has added support for standard file dialogue
  51. ;;;   boxes. If the filedia variable is set to 1, a dialogue box
  52. ;;;   will appear. If filedia is set to 0, the interface will be
  53. ;;;   via the command line.
  54.  
  55. (defun wb_err (s)                     ; If an error (such as CTRL-C) occurs
  56.                                       ; while this command is active...
  57.   (if (/= s "Function cancelled")
  58.     (princ (strcat "\n┐∙╗~: " s))
  59.   )
  60.   (setq sset1 nil)                    ; Free selection-sets if any
  61.   (setq sset2 nil)
  62.   (setq sset3 nil)
  63.   (setq ss_sol nil)
  64.   (setq ss_mat nil)
  65.   (setvar "cmdecho" ce)               ; Restore saved mode
  66.   (setvar "filedia" fd)
  67.   (setq *error* olderr)               ; Restore old *error* handler
  68.   (princ)
  69. )
  70.  
  71.  
  72. ;function that writes out the solid
  73.  
  74. (defun doit (/ sset1 sset3 count length ename)
  75.  
  76.    (setvar "filedia" 0)
  77. ;set undo marker. prompt for an insertion base point.
  78.  
  79.    (command "_.undo" "_group")
  80.    (initget 1)
  81.    (setvar "insbase" (getpoint "\n┤íñ▐íu░≥╖╟┬Iív: ")) (terpri)
  82.  
  83. ;prompt user to pick selection set and create selection set of all
  84. ;other entities
  85.  
  86.   (setq sset1 (ssget))
  87.    ;Check that something has been picked. If nothing is selected, exit
  88.    ;If selection set is valid, go ahead and writ out the entities.
  89.    (if (null sset1)
  90.      (progn (princ "\nÑ╝┐∩¿∞╣╧ñ╕íC")(setq loop 0))
  91.      (progn
  92.      ;Print out an explanation of what is happening
  93.      (princ "\n╜╨╡y¡╘; ª╣╣L╡{Ñi»α╢╖»╙Ñ╬ñ@¼q«╔╢ííC")
  94.      (princ "\n╣∩⌐≤╣╧ñ╕íu╝╚«╔«°Ñóív¬║▒íº╬, ñúñ⌐─╡Ñ▄íC")
  95.  
  96.      ;Make a null set  ss2 to add entities in it.
  97.      (setq sset2 (ssadd))
  98.      ;Call addent to add all the top level solids and
  99.      ;its children to sset2. Note: sset1 will be useless then.
  100.      (setq length (sslength sset1))
  101.      (setq count 0)
  102.       (repeat length
  103.        (setq test_top 0)
  104.        (setq solname (ssname sset1 count))
  105.        (addent solname)
  106.        (setq count (+ count 1))
  107.       )
  108.  
  109.      ;Lets get all the entities in the drawing
  110.      (setq sset3 (ssget "x"))
  111.  
  112.      ;subtract selection set (sset2) with picked items and their
  113.      ; children from the selection set of all entities(sset3)
  114.      ; or sset3 = sset3 - sset2
  115.      (setq count 0)
  116.      (setq length (sslength sset2))
  117.      (repeat length
  118.       (setq solname (ssname sset2 count))
  119.       (ssdel solname sset3)
  120.       (setq count (+ count 1))
  121.      )
  122.  
  123.      ;Now we'll get two more selection sets with special blocks in them
  124.      ;and remove them from sset3
  125.  
  126.      (setq ss_sol (ssget "x" (list (cons 2 "AME_SOL"))))
  127.      (setq count 0)
  128.      (setq length (sslength ss_sol))
  129.      (repeat length
  130.       (setq solname (ssname ss_sol count))
  131.       (ssdel solname sset3)
  132.       (setq count (+ count 1))
  133.      )
  134.  
  135.      (setq ss_mat (ssget "x" (list (cons 2 "AME_MAT"))))
  136.      (setq count 0)
  137.      (setq length (sslength ss_sol))
  138.      (repeat length
  139.       (setq solname (ssname ss_sol count))
  140.       (ssdel solname sset3)
  141.       (setq count (+ count 1))
  142.      )
  143.  
  144. ;erase all the other entities and save the file
  145.  
  146.       ;temporary deletion of sset3
  147.       (command "_.erase" sset3 "")
  148.       (if chk
  149.        (command "_.wblock" filename "_Yes" "*")
  150.        (command "_.wblock" filename "*")
  151.       )
  152.  
  153.  
  154. ;restore the drawing to how you found it
  155.  
  156.  
  157.    (command "_.undo" "_end" "_u")
  158.  
  159.    (princ "\nº╣ª¿ !")(setq loop 0)
  160.   )
  161.  )
  162.  (setvar "filedia" fd)
  163. )
  164. ;this function looks for entities in extended entity data
  165. (defun addent (ename / t_hand oldent lchild rchild n_value)
  166.  
  167.    (ssadd ename sset2)
  168.    ; get the Extended Entity DATA
  169.    (if
  170.       (= -3 (car (last (setq oldent (entget ename
  171.                    (list "AME_SOL"))))))
  172.  
  173.       ; Check the version number of the solid
  174.       ; if 1 then the solid is made with AME 2 else
  175.       ; if 0 then ot is AME 1.
  176.            (progn
  177.         (if
  178.           (= 0 (cdr (nth 2(last (last oldent)))) )
  179.           (setq n_value 6)
  180.                ;else
  181.           (setq n_value 7)
  182.              )
  183.         (if
  184.       ; Checking if the solid is a boolean ..
  185.       (= 7 (logand 255 (cdr (nth 4 (last (last oldent))))))
  186.       (progn
  187.           ;get the Back ground entity wire frameor pmesh of
  188.           ; top level solid only
  189.           (if
  190.             (= 0 test_top)
  191.             (progn
  192.  
  193.          (setq test_top 1)
  194.               (setq t_hand  (cdr (nth (+ n_value 2) (last (last oldent)))))
  195.               (if
  196.                 (/= "0" t_hand)
  197.                      (ssadd (handent t_hand) sset2)
  198.               )
  199.          ; Now lets get the Boundary files.
  200.               (setq t_hand  (cdr (nth (+ n_value 3) (last (last oldent)))))
  201.          (while (/= "0" t_hand)
  202.            (ssadd (handent t_hand) sset2)
  203.            (setq t_hand (cdr (last(last(last (entget
  204.             (handent t_hand)(list "AME_SOL")))))))
  205.          )
  206.             )
  207.           )
  208.           (setq t_hand  (cdr (nth n_value (last (last oldent)))))
  209.           (setq lchild (handent t_hand))
  210.           (addent lchild)
  211.           (setq t_hand  (cdr (nth (+ n_value 1) (last (last oldent)))))
  212.           (setq rchild (handent t_hand))
  213.           (addent rchild)
  214.       )
  215.                 ; For primitives lets get the background entity and
  216.                 ; the bfile
  217.                 (progn
  218.                     (setq listt (cdr (last (last oldent))))
  219.           (setq bglist (member (assoc '1005 listt) listt))
  220.                     (setq t_hand (cdr (car bglist)))
  221.           (if
  222.                 (/= "0" t_hand)
  223.                      (ssadd (handent t_hand) sset2)
  224.           )
  225.           (setq t_hand (cdr (car (cdr bglist))))
  226.           (while (/= "0" t_hand)
  227.                 (ssadd (handent t_hand) sset2)
  228.            (setq t_hand (cdr (last(last(last (entget
  229.             (handent t_hand)(list "AME_SOL")))))))
  230.                )
  231.                 )
  232.          )
  233.            )
  234.     )
  235. )
  236.  
  237. ;main function for wblksol command
  238.  
  239. (defun C:WBLKSOL (/ fd bs ce filename chk loop rep pu)
  240.  
  241.   (if (not SOLSUB)
  242.     (princ "\n░⌡ªµª╣Ñ\»αñº½e, Ñ▓╢╖Ѳ╕ⁿñJíuAME 2.0ív⌐╬íu¡▒░∞ív╢∞½¼╡{ªí íC")
  243.     (progn
  244.  
  245.       ;read start settings and set variables
  246.       (setq olderr *error*
  247.         *error* wb_err)
  248.  
  249.       (setq ce (getvar "cmdecho"))
  250.       (setvar "cmdecho" 0)
  251.       (setq fd (getvar "filedia"))
  252.       (setq pu (getvar "popups"))       ;check for null display
  253.       (setq bs (getvar "insbase"))
  254.       (command "_.undo" "_group")       ;set group marker
  255.  
  256. ;prompt for a file name
  257.  
  258.    (if (and (= 1 fd)(/= 0 pu))          ;Use a dialog if possible
  259.  
  260.      (progn
  261.       (setq filename (getfiled "½╪Ñ▀íu╣Ω┼Θív╣╧º╬└╔«╫" "" "dwg" 3))
  262.         (if (/= nil filename)
  263.           (setq chk (open filename "r"))
  264.         )
  265.      )
  266.      (progn                 ;If not a fan of dialogs
  267.       (setq filename (getstring "\n└╔ªW: ")) (terpri)
  268.       (setq chk (open (strcat filename ".dwg") "r"))
  269.      )
  270.    )
  271.  
  272.    (if (= 1 fd)
  273.      (progn
  274.       (if (/= nil filename)(progn (setq loop 0)(doit)))
  275.      )
  276.      (progn
  277.       (if chk (setq loop 1) (doit))
  278.        (while (= loop 1)
  279.          (initget "Yes No")
  280.          (prompt "ñw╕gªsª│ªPªW¬║╣╧└╔; \n")
  281.          (setq rep (getkword "¼Oº_╣w│╞ñ⌐ÑH╕m┤½? <N> "))
  282.           (cond ((= rep "No") (setq loop 0))
  283.                 ((= rep nil) (setq loop 0))
  284.                 ((= rep "Yes") (doit))
  285.           )
  286.        )
  287.      )
  288.    )
  289. ;restore variables and empty selection sets
  290.       (command "_.undo" "_end")       ;set group marker
  291.       (setvar "cmdecho" ce)
  292.       (setvar "insbase" bs)
  293.       (setq sset1 nil)
  294.       (setq sset2 nil)
  295.       (setq sset3 nil)
  296.       (setq ss_sol nil)
  297.       (setq ss_mat nil)
  298.       (setq *error* olderr)                 ;Restore old *error* handler
  299.     )
  300.   )
  301.   (princ)
  302. )
  303.  
  304.  
  305. ;This function strips out unwanted chatacters to return
  306. ;the drawing name without a path
  307. (defun gtname (name / lstchar blknm rep blk)
  308.   ;set lstchar to the last character in string
  309.   (setq lstchar (substr name (strlen name) 1))
  310.   ;set blknm to nothing
  311.   (setq blknm "")
  312.  
  313.      ;while lstchar is not what we are looking for
  314.      (while (and (/= "\\" lstchar)
  315.                  (/= ":" lstchar)
  316.                  (/= "/" lstchar)
  317.                  (> (strlen name) 0)
  318.             )
  319.  
  320.          ;if true, do this stuff
  321.          (progn
  322.            ;set lstchar to the last character in string
  323.            (setq lstchar (substr name (strlen name) 1))
  324.            ;append lstchar to blknm
  325.            (setq blknm (strcat blknm lstchar))
  326.            ;set name to all but last char
  327.            (setq name (substr name 1 (- (strlen name) 1)))
  328.          )
  329.      )
  330.      ;dump the slash or colon
  331.      (if (or  (= "\\" lstchar)
  332.               (= ":" lstchar)
  333.               (= "/" lstchar)
  334.          )
  335.        (setq blknm (substr blknm 1 (- (strlen blknm) 1)))
  336.      )
  337.      ;else stop and reverse string
  338.      (setq rep (strlen blknm))
  339.      (setq blk "")
  340.        (repeat rep
  341.            ;set lstchar to the last character in string
  342.            (setq lstchar (substr blknm (strlen blknm) 1))
  343.            ;append lstchar to blknm
  344.            (setq blk (strcat blk lstchar))
  345.            ;set name to all but last char
  346.            (setq blknm (substr blknm 1 (- (strlen blknm) 1)))
  347.        )
  348.    (setq blk blk)
  349. )
  350.  
  351. ;main function for insrtsol command
  352.  
  353. (defun c:insrtsol ( / filename name ins fd ce pu)
  354.  
  355.    (setq olderr *error*
  356.         *error* wb_err)
  357.  
  358.    (setq ce (getvar "cmdecho"))
  359.    (setvar "cmdecho" 0)
  360.    (setq fd (getvar "filedia"))
  361.    (setq pu (getvar "popups"))       ;check for null display
  362.    (if (= 0 (getvar "handles"))      ;enable handles
  363.        (command "_.handles" "_on")
  364.    )
  365.  
  366.    (command "_.undo" "_group")       ;set group marker
  367.  
  368.    (if (and (= 1 fd)(/= 0 pu))          ;Use a dialog if possible
  369.  
  370.      (setq filename (getfiled "Insert Drawing File of Solid" "" "dwg" 2))
  371.  
  372.      (progn
  373.        (setq filename (getstring "\n└╔ªW: "))  ;Just in case
  374.        (setq filename (strcat filename ".dwg"))     ;you're not a
  375.        (if (= nil (findfile filename))              ;fan of dialogs
  376.          (progn
  377.             (princ "\nºΣñú¿∞└╔«╫íC")
  378.             (setq filename nil)
  379.          )
  380.        )
  381.      )
  382.   )
  383.   (if (/= nil filename)
  384.     (progn
  385.      ;check to see that file is not already defined as a block in the
  386.      ;current drawing
  387.      (setvar "filedia" 0)
  388.      ;remove the .dwg part of the filename
  389.      (setq name (substr filename 1 (- (strlen filename) 4)))
  390.  
  391.      ;remove the drivename and path
  392.      (if (> (strlen name) 1)
  393.          (setq name (gtname name))
  394.      )
  395.  
  396.      (if (tblsearch "block" name)   ;check block name
  397.  
  398.       ;if block is already defined in drawing
  399.       (progn
  400.          (princ "\níu")(princ name)
  401.          (princ "ívªbÑ╪½e╣╧└╔ñññw¼░ñ@íu╝╨╖╟╣╧╕sívíC")
  402.          (princ "\n┤íñ▐íu╣╧╕s ")(princ name)(princ "ív? ")
  403.          (initget  "Yes No")
  404.          (setq ins (getkword "Yes/<No>: "))
  405.             (if (= ins "Yes")
  406.                (progn
  407.                   (princ "\n┐ΘñJíu┤íñ▐┬Iívñ╬íu▒█┬α¿ñívíC")
  408.                   (command "_.insert" name pause "" "" pause)
  409.                   (command "_.explode" "_l")
  410.                )
  411.             )
  412.       )
  413.  
  414.       ;if no block of this name exists in drawing
  415.       (progn
  416.       ;if a real file is selected, xref it, bind it and explode it
  417.          (if (/= nil filename)
  418.           (progn
  419.             (princ "\n┐ΘñJíu┤íñ▐┬Iívñ╬íu▒█┬α¿ñív: ")
  420.             (command "_.xref" "_a" filename pause "" "" pause)
  421.             (command "_.xref" "_b" name)
  422.             (command "_.explode" "_l")
  423.           )
  424.          )
  425.       )
  426.      )
  427.     )
  428.    )
  429.    (command "_.undo" "_end")       ;set group marker
  430.    (setvar "cmdecho" ce)
  431.    (setvar "filedia" fd)
  432.    (setq *error* olderr)                 ;Restore old *error* handler
  433.    (princ)
  434. )
  435.  
  436. (princ "\níuC:WBLKSOLív╗PíuC:INSRTSOLívñw╕ⁿñJ;")
  437. (princ " ╜╨ÑH WBLKSOL ñ╬ INSRTSOL ▒╥░╩½ⁿÑOíC")
  438. (princ)
  439.