[编程交流] 定制acaddoc。lsp

Enter new value for SPLINESEGS <20>: 20 FACETRES
Enter new value for FACETRES <10.0000>: 10 ISOLINES
Enter new value for ISOLINES <10>: 20 [b]DWG Unknown command "DWG".  Press F1 for 
help.[/b]

; 
; 
;North American Stone Drawing Set Up
;
;
;---------------------
;LISP Loads
;
(autoload "autoDPROP" '("autoDPROP"))
(autoload "nasc_props" '("nasc_props" "dwg"))
;ENVIRONMENT
(command "base" "0,0,0")
(setvar "osmode" 6255)
(command "-INSERT" "Z_STD_SETUP" "0,0" "1" "" "0")
(command "ERASE" "L" "")
(command "-STYLE" "SHEET" "tahoma.TTF" "0" "1" "0" "N" "N")
(command "-LAYER" "S" "0-STONE" "")
(command "-DIMSTYLE" "R" "16")
(command "LTSCALE" "6")
(command "PDMODE" "3")
(command "PDSIZE" "0")
(command "-HATCH" "P" "AR-SAND" "0.25" "0" "")
(command "-UNITS" "4" "16" "1" "0" "0" "N")
(command "VIEWRES" "Y""20000")
(command "SPLINESEGS" "20")
(command "FACETRES" "10")
(command "ISOLINES" "20")
(c:dwg)

(defun C:DWG () 

(c:dwg)

;;; *********************************************** *************************
;;; * Library DWGruLispLib Copyright © 2007 DWGru Programmers Group 
;;; * 
;;; * _dwgru-Dwgprops-get-all-prop 
;;; * 
;;; * 27/12/2007 Version 0001. Vladimir Azarko (VVA) 
;;; *********************************************** *************************
(defun _dwgru-dwgprops-get-all-prop (Doc / si ret nc key value) 
;;; Returns the file's properties, set the team _dwgprops 
;;; Returns an associative list, where the key is: 
;; - For properties created by the user (tab OTHER) 
;;; Property name 
;; - For standard properties (tab PAPER) 
;;; Key field 
;;; NAME - *TITLE* 
;;; AUTHOR - *AUTHOR* 
;;; TOPIC - *SUBJECT* 
;;; KEY WORDS - *KEYWORDS* 
;;; NOTES - *COMMENTS* 
;;; Hyperlink Base - *HYPERLINK* 
;;;!! Key fields are converted to uppercase 
;;; Doc - a pointer to the PDF document, nil - the current 
  
;;; Example 
;;; (_dwgru-dwgprops-get-all-prop nil) ;;;(("* AUTHOR * "" VVA ") (" * COMMENTS * "" Memo ") (" * HYPERLINK * "" Base ") 
                               ;;;("* KEYWORDS * "" Key ") (" * TITLE * "" named ") (" * SUBJECT * "" R ") (" UNIQKEY "" Key ")) 
(and
(or Doc
   (setq Doc (vla-get-activeDocument (vlax-get-acad-object)))
   )
(setq si (vla-get-SummaryInfo Doc))
(setq ret (list
    (list "*AUTHOR*" (vla-get-author si))
    (list "*COMMENTS*" (vla-get-comments si))
           (list "*HYPERLINK*" (vla-get-HyperlinkBase si))
    (list "*KEYWORDS*" (vla-get-keywords si))
           (list "*TITLE*" (vla-get-Title si))
    (list "*SUBJECT*" (vla-get-Subject si))
    )
)
(setq nc (vla-numcustominfo si))
(while (> nc 0) 
(vla-GetCustomByIndex si (- nc 1) 'key 'value)
(setq ret (append ret (list(list (strcase key) value))))  
(setq nc (1- nc))
)
(vlax-release-object si)
)
ret
)   
;;; *********************************************** *************************
;;; * Library DWGruLispLib Copyright © 2007 DWGru Programmers Group 
;;; * 
;;; * _dwgru-Dwgprops-get-custom-prop 
;;; * 
;;; * 27/12/2007 Version 0001. Vladimir Azarko (VVA) 
;;; *********************************************** *************************
(defun _dwgru-dwgprops-get-custom-prop (key Doc / app counter counter2 counter3 doc dwgprops kv) 
;;; Returns the value of the property created by the user (team _dwgprops) 
;;; Returns an associative list, where the key is: 
;; - For properties created by the user (tab OTHER) 
;;; Key - a string property name (tab OTHER) 
;; - For standard properties (tab PAPER) 
;;; Key field 
;;; NAME - *TITLE* 
;;; AUTHOR - *AUTHOR* 
;;; TOPIC - *SUBJECT* 
;;; KEY WORDS - *KEYWORDS* 
;;; NOTES - *COMMENTS* 
;;; Hyperlink Base - *HYPERLINK* 
;;; 
;;; Uses the library 
;;; _dwgru-Dwgprops-get-all-prop 
;;; _dwgru-Assoc (_dwgru-assoc-multi) 
  
;;; Doc - a pointer to the PDF document, nil - the current 
  
 (cadr (_dwgru-assoc key (_dwgru-dwgprops-get-all-prop Doc))) 
) 
;;; *********************************************** *************************
;;; * Library DWGruLispLib Copyright © 2007 DWGru Programmers Group 
;;; * 
;;; * _dwgru-Dwgprops-set-custom-prop 
;;; * 
;;; * 27/12/2007 Version 0001. Vladimir Azarko (VVA) 
;;; *********************************************** *************************
(defun _dwgru-dwgprops-set-custom-prop (key value Doc / si) 
;;, Create in the properties of the figure (team _dwgprops bookmark OTHER) 
;;; Property with key and value value 
;;; If the property was not, it is created, otherwise the changes 
;;; Key - a string property name (tab OTHER) 
;;; Value - a string (string) - value of property 
;;; Uses the library 
;;; _dwgru-Dwgprops-get-custom-prop 
;;; Doc - a pointer to the PDF document, nil - the current 
;;; Returns - nil 
;;; Example 
;;; (_dwgru-dwgprops-set-custom-prop "dwgru" "dwgru-dwgprops-set-custom-prop" nil) 
  (or Doc 
  (setq Doc (vla-Get-ActiveDocument (vlax-Get-Acad-Object))) 
    ) 
  (setq si (vla-Get-SummaryInfo Doc)) 
  (if (_dwgru-dwgprops-get-custom-prop key Doc) 
    (vla-SetCustomByKey si key value) 
    (vla-AddCustomInfo si key value) 
  ) 
) 
(defun _dwgru-assoc-multi (key lst) 
  (if (= (type key) 'str) 
    (setq key (strcase key)) 
    ); _ End of if 
  (vl-remove-if-not 
    (function 
      (lambda (a / b) 
        (and (setq b (car a)) 
             (or (and (= (type b) 'str) (= (strcase b) key)) (equal b key)) 
             ); _ End of and 
        ); _ End of lambda 
      ); _ End of function 
    lst 
    ); _ End of vl-remove-if-not 
  ); _ End of defun 
(defun _dwgru-assoc (key lst) 
  (car (_dwgru-assoc-multi key lst)) 
  ); _ End of defun

;;; *********************************************** *************************
;;; * NASC Field Properties* 
;;; * 
;;  *Allows user to type in job info in command bar*
;;  *for use with the FIELDS in the titleblock*
;;; * 
;;  *For North American Stone Company*
;;; * 
;;; * 11/09/2009 Version 0001. Vladimir Azarko (VVA) 
;;; *********************************************** *************************
(defun C:DWG () 
(vl-load-com) ;;; Do not forget to add
  (setq str (getstring t "\nJob Number:")) 
  (_dwgru-dwgprops-set-custom-prop "Job Number" str nil)
  (setq str (getstring "\nCustomer:")) 
  (_dwgru-dwgprops-set-custom-prop "Customer" str nil)
  (setq str (getstring t "\nAddress:")) 
  (_dwgru-dwgprops-set-custom-prop "Address" str nil)
  (setq str (getstring t "\nCity St:")) 
  (_dwgru-dwgprops-set-custom-prop "City St" str nil)
  (setq str (getstring t "\nColor:")) 
  (_dwgru-dwgprops-set-custom-prop "Color" str nil)
  (setq str (getstring t "\nDrawn By:")) 
  (_dwgru-dwgprops-set-custom-prop "Drawn By" str nil)  
  (setq str (getstring t "\nDelivery Date:")) 
  (_dwgru-dwgprops-set-custom-prop "Delivery Date" str nil)
  (setq str (getstring t "\nDrawing Date:")) 
  (_dwgru-dwgprops-set-custom-prop "Drawing Date" str nil)
  (setq str (getstring t "\nFinish:")) 
  (_dwgru-dwgprops-set-custom-prop "Finish" str nil)
  )