[编程交流] 不使用发布打印

(defun C:SPC (/)
 (vl-load-com)
 (setvar 'backgroundplot 0)
 (vlax-for dwg (vla-get-documents (vlax-get-acad-object))
   (setq plotcons (vla-get-PlotConfigurations dwg))
   (setq plotcon (vl-catch-all-apply 'vla-Item (list plotcons "PDF-Fit")))
   (if (/= (type plotcon) 'VLA-OBJECT)
     (if (= (getvar "TILEMODE") 0)
(setq plotcon (vla-Add plotcons "PDF-Fit" :vlax-false))
(setq plotcon (vla-Add plotcons "PDF-Fit" :vlax-true))
)
     )
   (vla-RefreshPlotDeviceInfo plotcon)
   (vla-put-ConfigName plotcon "Adobe PDF")
   (vla-put-CanonicalMediaName plotcon "Ledger")
   (vla-put-PaperUnits plotcon acInches)
   (if (= (getvar "TILEMODE") 0)
     (progn
(vla-put-PlotType plotcon acLayout)
(vla-put-UseStandardScale plotcon :vlax-true)
(vla-put-StandardScale plotcon ac1_1)
)
     (progn
(vla-put-PlotType plotcon acExtents)
(vla-put-UseStandardScale plotcon :vlax-true)
(vla-put-StandardScale plotcon acScaleToFit)
(vla-put-CenterPlot plotcon :vlax-true)
)
     )
   (vla-put-PlotHidden plotcon :vlax-false)
   (vla-put-PlotRotation plotcon ac0degrees)
   (vla-put-PlotViewportBorders plotcon :vlax-false)
   (vla-put-PlotViewportsFirst plotcon :vlax-true)
   (vla-put-PlotWithLineweights plotcon :vlax-true)
   (vla-put-ScaleLineweights plotcon :vlax-true)
   (vla-put-PlotWithPlotStyles plotcon :vlax-true)
   (vla-put-ShowPlotStyles plotcon :vlax-true)
   (if (= (getvar "PSTYLEMODE") 0)
     (vla-put-StyleSheet plotcon "grayscale.stb")
     (vla-put-StyleSheet plotcon "grayscale.ctb")
     )
   (vla-plottodevice (vla-get-plot dwg))
   )
 )

(setq newstr ""
newstr2 "")
(setq ss1 (car (entsel)))  ; pick a block
(foreach att (vlax-invoke (vlax-ename->vla-object SS1) 'getattributes)
       (setq newstr (strcat newstr "," (vla-get-textstring att )))
       (setq newstr2 (strcat newstr2 "," (vla-get-tagstring att)))
)
(princ newstr)
(princ newstr2)

(Defun C:PDF (/ PSpaces Center Center2 PlotList PlotTabs)
 (vl-load-com)
 (setvar "FILEDIA" 0)
 (setvar "CMDDIA" 0)
 (setq PSpaces (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))))
 (setq Center 0)
 (setq Center2 0)
 (repeat (vla-get-count PSpaces)
   (setq PlotList (cons (setq Center (1+ Center)) PlotList))
   )
 (vlax-for PlotTab PSpaces
   (setq PlotList (subst (vla-get-name PlotTab)(vla-get-taborder PlotTab)PlotList))
   )
 (setq PlotList (reverse PlotList))
 (while (/= Center2 (1- Center))
   (setq PlotTabs (nth Center2 PlotList))
   (command "-PLOT" "y" PlotTabs "Adobe PDF" "Ledger" "Inches" "Landscape" "No" "Extents" "1:1" "Center" "Yes" "acad.ctb" "Yes" "No" "No" "No" "No" "Yes" "Yes")
   (setq Center2 (1+ Center2))
   )
 (setvar "FILEDIA" 1)
 (setvar "CMDDIA" 1)
 (princ)
 )

(vl-load-com)
(progn
 (setq dirltr (list "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z")) ;;possible dir locations
 (foreach Dir dirltr
   (if (or (/= (findfile (strcat Dir":\\Loader.lsp")) nil) (/= (findfile (strcat Dir":\\Loader.fas")) nil));;find flash drive dir
     (setq Path Dir)
     )
   )
 (setq lload '())
 (foreach file (vl-directory-files (strcat Path ":\") "*.fas");;locate all fas files in main dir
   (setq lload (append lload (list file)))
   )
 (foreach file (vl-directory-files (strcat Path ":\") "*.lsp");;locate all lsp files in main dir
   (setq lload (append lload (list file)))
   )
 (Foreach lisp Lload
   (if (not (or (= (strcase lisp) (strcase "Loader.lsp")) (= (strcase lisp) (strcase "Loader.fas"))))
     (progn
(load (strcat Path ":\" Lisp))
(princ (strcat lisp "\r\n"))
)
     )
   )
 )

(defun C:BM ( / attlst ent entN Block BlName cadblk attobjlst objatt promstr attprom attname atttext attlst attr attlst2 ent2 entN2 Block2 BlName2 cadblk2 attobjlst2 objatt2 promstr2 attprom2 attname2 atttext2 attlst2 attr2 name prom text)
 (vl-load-com)
 (setq attlst nil)
 (setq attlst2 nil)
 (if (setq ent (entsel "\nSelect a block to copy attributes from: "))
   (progn
     (setq entN (car ent))
     (setq Block (vlax-ename->vla-object entN))
     (setq BlName (vla-get-name Block))
     (setq cadblk (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BlName))
     (if (= (vla-get-hasattributes Block) :vlax-true)
(setq attobjlst (vlax-safearray->list (variant-value (vla-getattributes Block))))
)
     (foreach objatt attobjlst
(vlax-for promstr cadblk
  (if (= (vla-get-objectname promstr) "AcDbAttributeDefinition")
    (progn
      (if (= (vla-get-ObjectID objatt) (vla-get-ObjectID promstr))
        (progn
          (setq attprom (vla-get-promptstring promstr))
          )
        )
      )
    )
  )
(setq attname (vla-get-tagstring objatt))
(setq atttext (vla-get-textstring objatt))
(setq attlst (append attlst (list (list objatt attname attprom atttext))))
    )
  )
   (princ "..no object selected.")
   )
 (if (setq ent2 (entsel "\nSelect a block to copy attributes to: "))
   (progn
     (setq entN2 (car ent2))
     (setq Block2 (vlax-ename->vla-object entN2))
     (setq BlName2 (vla-get-name Block2))
     (setq cadblk2 (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) BlName2))
     (if (= (vla-get-hasattributes Block2) :vlax-true)
(setq attobjlst2 (vlax-safearray->list (variant-value (vla-getattributes Block2))))
)
     (foreach objatt2 attobjlst2
(vlax-for promstr2 cadblk2
  (if (= (vla-get-objectname promstr2) "AcDbAttributeDefinition")
    (progn
      (if (= (vla-get-Handle objatt2) (vla-get-Handle promstr2))
        (progn
          (setq attprom2 (vla-get-promptstring promstr2))
          )
        )
      )
    )
  )
(setq attname2 (vla-get-tagstring objatt2))
(setq atttext2 (vla-get-textstring objatt2))
(setq attlst2 (append attlst2 (list (list objatt2 attname2 attprom2 atttext2))))
    )
  )
   (princ "..no object selected.")
   )
 (foreach attr attlst
   (setq name (nth 1 attr))
   (setq prom (nth 2 attr))
   (setq text (nth 3 attr))
   (foreach attr2 attlst2
     (if (and (= name (nth 1 attr2))(= prom (nth 2 attr2)))
(vla-put-textstring (nth 0 attr2) text)
)
     )
   )
 (princ)
 )