@pm:add-frame-by-box

说明:外框

用法:

 (@pm:add-frame-by-box box)

参数:box

返回值:

示例:

(defun @pm:add-frame-by-box (box / height width paper tk _scale @pm:calc-mapsheet)
  (defun @pm:calc-mapsheet (height width _scale / i paper ps)
  ;; 考虑绘图比例    (setq i -1)
    (while (and (< (setq i (1+ i))(length @:paper-size))
		(or 
		 (>= height(* (@:scale (* 100 _scale)) (+ (caddr (nth i @:paper-size)) 2)))
		 (>= width (* (@:scale (* 100 _scale)) (+ (cadr (nth i @:paper-size)) 2))))))
    (if (< i (length @:paper-size))
	(setq paper  (car (nth i @:paper-size)))
	;; 按合适的长宽比例缩放图纸	(progn
	  (setq ps (vl-sort @:paper-size '(lambda (x y)
					   (or (and (equal (/ (cadr x)(caddr x)) (/ (cadr y)(caddr y)) 0.001)
						(> (caddr x)(caddr y)))
					    (< (/ (cadr x)(caddr x))(/ (cadr y)(caddr y)))))))
	  (setq i -1)
	  (while (< (/ width height) (/ (cadr (nth (setq i (1+ i)) ps)) (caddr (nth i ps)))))
	  (if (< i (length @:paper-size))
	      (setq paper (car (nth i ps)))
	      (setq paper (car (last ps)))
	      )
	  ))
    paper)
  (if(< (apply 'angle box) (* 0.25 pi))
      (setq box
	    (list
	     (polar 
	      (polar (car box) pi (@:scale 25))
	      (* 1.5 pi) (@:scale 10))
	     (polar 
	      (polar (cadr box) 0 (@:scale 80))
	      (* 0.5 pi) (@:scale 10))))
    (setq box
	  (list
	   (polar 
	    (polar (car box) pi (@:scale 10))
	    (* 1.5 pi) (@:scale 80))
	   (polar 
	    (polar (cadr box) 0 (@:scale 10))
	    (* 0.5 pi) (@:scale 25)))))
  
  (setq height (- (cadr (cadr box))
		  (cadr (car box))))
  (setq width (- (car (cadr box))
		 (car (car box))))
  (setq scales '(1 0.5 0.3 0.2 0.1 0.05 0.01))
  ;; 计算适合的比例  (setq  tmp_scale (/ height (@:scale 210)))
  (cond
    ((> tmp_scale 1)
     (setq _scale 0.01))
    ((> 1 tmp_scale 0.5)
     (setq _scale 0.005))
    ((> 0.5 tmp_scale 0.3)
     (setq _scale 0.003))
    ((> 0.3 tmp_scale 0.2)
     (setq _scale 0.002))
    ((> 0.2 tmp_scale)
     (setq _scale 0.001)))
   
  (if (> _scale 0.0009)
      (if (< (/ height width) 1.0)
	  (progn
	    ;;水平框	    (setq paper (@pm:calc-mapsheet height  width _scale))
	    ;;未下载图框的问题	    (or (member (@:get-config '@pm:tukuang)(block:list))
		(and (setq tmp-tk
			   (@pm:insert-tukuang-backend
			    "at-pm/map-sheet.dwg"
			    (@:get-config '@pm:tukuang)
			    '(0 0 0))
			   )
		     (entdel tmp-tk))
		)
	    ;;计算插入点	    (setq tk
		  (block:insert
		   (@::get-config '@pm:tukuang)
		   (strcat (@::get-config '@pm:tuku)"\\")
		   (polar 
		    (polar (point:centroid box) (* 1.5 pi)
			   (* 0.5 (@:scale (* 100 _scale)) ;;  (@::get-config '@::draw-scale)			      (cadr (cdr (assoc paper @:paper-size)))))
		    0
		    (* 0.5 (@:scale (* 100 _scale)) ;;(@::get-config '@::draw-scale)		       (car (cdr (assoc paper @:paper-size)))))
		   0 (@:scale _scale)))
	    (block:set-dynprop tk "map-sheet" paper)
	    )
	  (progn
	    ;;竖向框	    (setq paper (@pm:calc-mapsheet width height _scale))
	    ;;计算插入点	    (setq tk
		  (block:insert
		   (@::get-config '@pm:tukuang)
		   (strcat (@::get-config '@pm:tuku)"\\")
		   (polar 
		    (polar (point:centroid box) (* 1.0 pi)
			   (* 0.5 (@:scale (* 100 _scale)) ;;(@::get-config '@::draw-scale)			      (cadr (cdr (assoc paper @:paper-size)))))
		    (* 1.5 pi)
		    (* 0.5 (@:scale (* 100 _scale));; (@::get-config '@::draw-scale)		       (car (cdr (assoc paper @:paper-size)))))
		   (* 1.5 pi) (@:scale _scale)))
	    (block:set-dynprop tk "map-sheet" paper)
	    )
	  
	  )
      (@::prompt "图形高度太小，跳过套图框")
      ))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@pm:add-frame-by-box

上传记录