saw-blade:sawtooth

说明:

用法:

 (saw-blade:sawtooth pts)

参数:pts

返回值:

示例:

(defun saw-blade:sawtooth (pts / segs res n1 n2 n3 n4 fuzz rad max-angle min-angle maxlength-corner ang)
  "路口圆角"
  (setq rad (@::get-config 'saw-blade:radius)
      maxlength-corner  (@::get-config 'saw-blade:maxlength-corner)
      max-angle (angtof (@::get-config 'saw-blade:max-angle))
      min-angle (angtof (@::get-config 'saw-blade:min-angle))
      )
  (setq segs (mapcar (quote (lambda (x)
			      (cons x 0)))
		     pts))
  (setq n1 (car segs))
  (setq res (cons n1 nil))
  (setq segs (cdr segs))
  
  (setq n2 (car segs))
  (setq res (cons n2 res))
  (setq segs (cdr segs))
  
  (setq n3 (car segs))
  (setq res (cons n3 res))
  (setq segs (cdr segs))
  (cond
   ((and (= 0 (cdr n1))
	 (= 0 (cdr n2))
	 (> (distance (car n1)
		      (car n2))
	    (* 2 maxlength-corner))
	 (> (distance (car n2)
		      (car n3))
	    (* 2 maxlength-corner))
	 (< min-angle
	    (progn
	      (setq ang
		    (m:fix-angle
		     (- (angle (car n2)
			       (car n1))
			(angle (car n2)
			       (car n3)))))
	      (if (> ang pi)
		  (setq ang (- (* 2 pi) ang)))
	      ang)
	    max-angle)
	 )
    (and (setq pts-fillet (saw-blade:calc-fillet-3pts n1 n2 n3))
	 (setq res (cons
		    (cons (car pts-fillet)
			  (apply 'curve:o2bulge pts-fillet))
		    (cddr res)))
	 (setq res (cons
		    (cons (cadr pts-fillet)
			  (cdr n3))
		    res))
	 (setq res (cons n3 res))
	 )))
  (while (setq n4 (car segs))
    (cond
     ((and (= 0 (cdr n2))
	   (= 0 (cdr n3))
	   (> (distance (car n2)
		      (car n3))
	      (* 2 maxlength-corner))
	   (> (distance (car n3)
			(car n4))
	      (* 2 maxlength-corner))
	   (< min-angle
	      (progn
		(setq ang
		      (m:fix-angle
		       (- (angle (car n2)
				 (car n1))
			  (angle (car n3)
				 (car n4)))))
		(if (> ang pi)
		    (setq ang (- (* 2 pi) ang)))
		ang)
	      max-angle)
	   )
      (and (setq pts-fillet (saw-blade:calc-fillet-3pts n2 n3 n4))
	   (setq res (cons
		      (cons (car pts-fillet)
			    (apply 'curve:o2bulge pts-fillet))
		      (cdr res)))
	   (setq res (cons
		      (cons (cadr pts-fillet)
			    (cdr n3))
		      res))
	   ))
     ((and (= 0 (cdr n1))
	   (= 0 (cdr n3))
	   ;; n2 短	   (< (distance (car n2)
			(car n3))
	      maxlength-corner) ;; ;; 角度	   (< min-angle
	      (progn
		(setq ang
		      (m:fix-angle
		       (- (angle (car n2)
				 (car n1))
			  (angle (car n3)
				(car n4)))))
	       (if (> ang pi)
		   (setq ang (- (* 2 pi) ang)))
	       ang)
	     max-angle)
	   )
      (and (setq pts-fillet (saw-blade:calc-fillet-pts n1 n2 n3 n4))
	   (setq res (cons
		      (cons (car pts-fillet)
			    (apply 'curve:o2bulge pts-fillet))
		      (cddr res)))
	   (setq res (cons
		      (cons (cadr pts-fillet)
			    (cdr n3))
		      res))
	   )))
    (setq res (cons n4 res))
    (setq n1 (caddr res))
    (setq n2 (cadr res))
    (setq n3 (car res))
    (setq segs (cdr segs)))
  
  (setq res (reverse res))
  (entity:make-lwpline-bold (mapcar (quote car)
				    res)
			    (mapcar (quote cdr)
				    res)
			    0
			    0
			    0)
  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

saw-blade:sawtooth

上传记录