route-of-hole2shape:route

说明:

用法:

 (route-of-hole2shape:route pt-c ent-pl clockwise offset closeto?)

参数:pt-c;ent-pl;clockwise;offset;closeto?

返回值:

示例:

(defun route-of-hole2shape:route (pt-c ent-pl clockwise offset closeto?
				       / ent-shape ent-pts pt-closeto
				       convexity closed?)
  ;; closeto? T 为曲线上的任意点， nil 为曲线上的顶点  ;;选择多段线  ;; 方向不同 正负不同  (if (null layer:make) (require 'layer:*))
  (layer:make (@:get-config  'ROUTE-OF-HOLE2SHAPE:layer)
	    (@:get-config  'ROUTE-OF-HOLE2SHAPE:color)
	    nil nil)
  (setq ent-shape (route-of-hole2shape:offset-shape ent-pl))
  (setq closed? (entity:getdxf ent-shape 70))
  ;; 逆时针点序不对  (if (and (/= (curve:clockwisep ent-shape)
	       clockwise)
	   (= 1 closed?))
      (progn
	(setq ent-shape1 (curve:lwpl-turn-clockwise ent-shape))
	(entdel ent-shape)
	(setq ent-shape ent-shape1
	      ent-shape1 nil)
 	))

(setq ent-pts (curve:pline-3dpoints ent-shape))
  (setq convexity (curve:pline-convexity ent-shape))
  (if (> (length ent-pts) (entity:getdxf ent-shape 90))
      (if closeto?
	  (setq ent-pts (reverse(cdr(reverse ent-pts))))
	(setq ent-pts (cdr ent-pts))))
  (if (> (length convexity) (entity:getdxf ent-shape 90))
      (setq convexity (reverse(cdr(reverse convexity)))))
  (if (= 1 closed?)
      (if closeto?
	  (setq pt-closeto (route-of-hole2shape:pt-closeto-curve pt-c ent-shape))
	(setq pt-closeto (route-of-hole2shape:pt-closeto-vertex pt-c ent-shape)))
    (if (= 0 closed?)
	(if (< (distance pt-c (car ent-pts))
	       (distance pt-c (last ent-pts)))
	    (setq pt-closeto (car ent-pts))
	  (progn
	    (setq pt-closeto (last ent-pts))
	    (setq ent-pts (reverse ent-pts)))
	  )))
			  
   ;; 最近点是否与顶点重合  (setq i -3)
  (while (and
	  (> (distance (car ent-pts) pt-closeto) 0.00001)
	  (not (curve:pt-in-arc-p
		    pt-closeto
		    (car ent-pts)
		    (cadr ent-pts)
		    (car convexity)))
	  (<= i (length ent-pts)))
    (setq ent-pts (append (cdr ent-pts) (list (car ent-pts))))
    (setq convexity (append (cdr convexity) (list (car convexity))))
    (setq i (1+ i))
    )
  (setq ent-pts (append (cdr ent-pts) (list (car ent-pts))))
  (setq convexity (append (cdr convexity) (list (car convexity))))
  ;; 修正最后两点相同  ;; (if (= (car (reverse ent-pts))  ;; 	 (cadr (reverse ent-pts)))  ;;     (setq ent-pts (reverse (cdr (reverse ent-pts)))))  
  ;; 修正 凸度  (if (equal (apply 'min (mapcar '(lambda(x)(distance x pt-closeto)) ent-pts))
	     0.0 0.0000001)
      (progn
	(princ "最近点为顶点\n")
	(if (= 1 closed?)
	    (progn
	      (if (equal 0.0 (distance pt-closeto (car ent-pts)) 0.0000001)
		  (progn 
		    (setq ent-pts (append (cdr ent-pts)(list (car ent-pts))))
		    (setq convexity (append (cdr convexity)(list (car convexity)))))
		    )
	      (setq new-convexity (append (list 0) convexity (list 0)))
	      (setq new-pts (append (list pt-c pt-closeto) ent-pts )))
	  (progn 
	    (setq new-convexity (append (list 0) convexity))
	    (setq new-pts (append (list pt-c pt-closeto) (reverse (cdr (reverse ent-pts))))))))
      (progn
	(setq new-convexity
	      (if (= 0 (last convexity))
		  (setq convexity (append (list 0 0) convexity (list 0)))
		(progn 
		  (setq O (curve:bulge2O (last ent-pts)(car ent-pts)(last convexity)))
		  (setq convexity
			(append (list 0)
				(list (* (if (> (last convexity)0) 1 -1)(curve:O2bulge pt-closeto
									   (car ent-pts)
									   O)))
				(reverse(cdr (reverse convexity)))
				(list  (* (if (> (last convexity)0) 1 -1) ;;(if clockwise 1 -1)					  (curve:O2bulge pt-closeto
							 (last ent-pts)
							 O)))
				(list 0)))
		  )))
	(setq new-pts (append (list pt-c pt-closeto) ent-pts (list pt-closeto)))
	;;(format t "vertexs ~a | ~a" (length new-pts)(length ent-pts))
	))
  ;; (princ "\n")  ;; (princ convexity)(princ "\n")  ;; (princ ent-pts)(princ "\n")  ;; (princ "\n")  ;; (princ new-convexity)(princ "\n")  ;; (princ new-pts)(princ "\n")  ;;(curve:ptoncurve pt ;; 顺时针为 红，逆时针为  (push-var nil)
  (setvar "osmode" 0)
  (entity:putdxf
   (entity:putdxf 
    (entity:make-lwpline-bold
     new-pts new-convexity nil closed? 0)
    62 222);; (if clockwise 1 2))   8 (@:get-config 'route-of-hole2shape:layer))
  (entdel ent-shape)
  (pop-var)
  (princ)
  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

route-of-hole2shape:route

上传记录