@pm:mprint

说明:

用法:

 (@pm:mprint frames pdf)

参数:frames;pdf

返回值:

示例:

(defun @pm:mprint (frames pdf / *error* content% s1 minpoint maxpoint tufu ti% boxInsp boxScale boxRotate corner p1 p2 tuming old-ucs-name)
  (defun *error* (msg)
    (pop-var)
    (princ msg)(princ))
  (@:help
   (strcat "批量打印选中的图框，直接回车打印当前图的所有图框。\n"
	   "    PDF 输出文件名前缀 可在《配置管理》中的 @pm:pdf-prefix 设置。"
	   ))
  ;;(command "undo" "be")  (push-var '("snapmode""gridmode""osmode"))
  (setq old-ucs-name (getvar "ucsname"))
  (if (= 42 (ascii old-ucs-name))
      (setq old-ucs-name ""))
  (setvar "snapmode" 0)
  (setvar "gridmode" 0)
  (if (< (getvar"osmode") 16384)
      (setvar "osmode" (+ (getvar"osmode") 16384)))
  ;;(if (not is-zwcad) (setvar "3dosmode" 1))  
  (setq s1 (@pm:frames2contents frames))
  (setq ti% 0)
  (setq sum-plot 0)
  (if (/= s1 nil)
      (progn
	(while (< ti% (length s1) )
	  (setq content% (nth
			  ti% s1))
	  (setq tufu (@pm:get-map-sheet content%))
	  (setvar "cmdecho" 0)
	  (setvar "ctab" (@pm:get-layout content%))

(setq boxScale (float (cdr (assoc "boxScale" content%))))
	  (setq boxRotate (float (cdr (assoc "boxRotate" content%))))
	  ;; 图框角度不为0	  (if (and (/= (- boxRotate (geometry:ucs-angle)) 0)
		   (= "Model" (getvar "ctab")))
	      (progn
		(command "ucs" "ob" (cdr (assoc "ename" content%)))
		(command "plan" "c")))
	  
	  (setq boxInsp (cdr (assoc "boxInsp" content%)))

(if (and (setq tufu-number (cdr (assoc tufu  @:paper-size)))
		   (cdr (assoc (@:get-config '@pm:drawing-number) content%)))
	      (progn
		(setq corner (@pm:get-corner content%))
		(if (> (abs (- (car (car corner))(car (cadr corner))))
		       (abs (- (cadr (car corner))(cadr (cadr corner)))))
		    (setq zongheng "L")
		  (setq zongheng "P"))
		(setq dir-path (@:mkdir
				(append (@:path (@:get-config '@pm:projects-output))
					(list (text:remove-fmt (cdr (assoc "项目名称" content%)))
					      (text:remove-fmt (cdr (assoc "工程名称" content%)))
					      (text:remove-fmt (cdr (assoc "子项名称" content%)))
					      (@pm:get-tubie content%))
					)))
		(if (>= (@:get-config '@pm:print-tuming) 1)
		    (progn
		      (setq tuming (@:string-subst "" " "
						   (@pm:get-tuming content%)))
		      ;; 替换特殊字符		      (setq tuming (filename:replace-special tuming))
		      (if (> (strlen tuming) 0)
			  (setq tuming (strcat "_" tuming)))
		      )
		  (setq tuming "")
		  )
		(setq tuhao (cdr (assoc (@:get-config '@pm:drawing-number) content%)))
		(setq tuhao (filename:replace-special tuhao))
		;;建立工程目录 建设单位 工程名称 子项名称 施工图 专业 		;; 打印需要的数据 p1 p2 两个点，保存的文件名(含目录)		(if  (and tufu-number
			  (/= tufu "非标图框")
			  (cdr (assoc (@:get-config '@pm:drawing-number) content%)))
		    (progn
		      (princ (strcat (rtos (nth 1 tufu-number)) "x" (rtos (nth 0 tufu-number))
				     ": "(rtos boxScale)  "\n"))
		      (setq tufu (@pm:handle-tufu tufu))
		      (if (>= (@:get-config '@pm:print-tuming) 2)
			  ;;图幅			  (setq tuming (strcat tuming "_" (filename:replace-special tufu))))
		      (setq file-name (strcat  dir-path "\\"
					   (@:get-config '@pm:pdf-prefix)
					   (if (and (= 1 (@:get-config '@pm:prefix-profession))
						    (@pm:have-tubie-attribute content%))
					       (strcat (@pm:get-tubie content%) "-" tuhao)
					       tuhao)
					   tuming
					   ".pdf"))
		      (if (= 1 pdf)
			  (plot:to-pdf tufu zongheng (car corner) (cadr corner) file-name))
		      (if (= 0 pdf)
			  (plot:to-dev tufu zongheng (car corner) (cadr corner)))
		      (setvar "cmdecho" 1)
		      )
		  (if (cdr (assoc (@:get-config '@pm:drawing-number) content%))
		      (@:log "WARR" (strcat (cdr (assoc(@:get-config '@pm:drawing-number)  content%)) tuming " 为非标准图框，不能打印。"))
		    (@:log "WARR" "非标准图框，不能打印。"))
		  
		  ))
	    (@:log "WARR" (strcat (if (cdr (assoc (@:get-config '@pm:drawing-number) content%)) (cdr (assoc (@:get-config '@pm:drawing-number) content%))) tufu  " 本程序不支持"))
	    )
	  ;;end plot	  (setq ti% (+ 1 ti%)))
	))
  ;;打印处理  (if (= "Model" (getvar "ctab"))
      (if (or (= "" old-ucs-name)(null old-ucs-name))
	  (progn (command "ucs" "w")(command "plan" "C"))
	(progn (command "ucs" "NA" "R" old-ucs-name)(command "plan" "C"))))
  ;; 打开最后一张图的目标文件夹  (pop-var)
  (setq folder (vl-filename-directory file-name))
  (if (and (= 1 (@:get-config '@pm:merge-pdf))
	   (p:functionp pdftk:merge))
      (pdftk:merge folder))
  (system:explorer folder)
  (princ)
  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@pm:mprint

上传记录