at-curve:notch

说明:凹口

用法:

 (at-curve:notch)

参数:

返回值:

示例:

(defun at-curve:notch (/ args)
  (@::prompt '("在丁字线交点处生成缺口。"))
  (if (setq args (ui:input
		  "缺口参数"
		  (list
		   (list "缺口宽度" (@:get-config '@curve:notch-width))
		   (list "缺口深度" (@:get-config '@curve:notch-height)))))
      (progn
	(setq width (cdr (assoc "缺口宽度" args)))
	(setq height (cdr (assoc "缺口深度" args)))
	(@:set-config '@curve:notch-width width)
	(@:set-config '@curve:notch-height height)
	(setq lst-line (pickset:to-list (ssget '((0 . "line")))))
	(foreach
	 line% lst-line
	 (setq pts (curve:get-points line%))
	 ;; pt-a	 (setq pt-a (car pts))
	 (setq pt-b (cadr pts))
	 (if (> (sslength (setq ss (ssget "c" pt-a pt-a '((0 . "line"))))) 1)
	     (progn
	       (setq ss (ssdel line% ss))
	       (foreach l2 (pickset:to-list ss)
			(setq ang(abs (- (angle (entity:getdxf l2 10)
						(entity:getdxf l2 11))
					 (angle (entity:getdxf line% 10)
						(entity:getdxf line% 11)))))
			(while (> ang pi)(setq ang (- ang pi)))
			
			(if (equal ang (* 0.5 pi) 0.07)
			    (progn
			      (entity:putdxf line% 10
					     (polar pt-a
						    (angle pt-a pt-b)
						    height))
			      (if (> (distance (entity:getdxf l2 10) pt-a)
				     (* 0.5 width))
				  (progn
				    (entity:make-line
				     (entity:getdxf l2 10)
				     (polar pt-a
					    (angle pt-a (entity:getdxf l2 10))
					    (* 0.5 width)))
				    (entity:make-line
				     (polar pt-a
					    (angle pt-a (entity:getdxf l2 10))
					    (* 0.5 width))
				     (polar pt-a
					    (angle pt-a pt-b)
					    height))
				    ))
			      (if (> (distance (entity:getdxf l2 11) pt-a)
				     (* 0.5 width))
				  (progn
				    (entity:make-line
				     (entity:getdxf l2 11)
				     (polar pt-a
					    (angle pt-a (entity:getdxf l2 11))
					    (* 0.5 width)))
				    (entity:make-line
				     (polar pt-a
					    (angle pt-a (entity:getdxf l2 11))
					    (* 0.5 width))
				     (polar pt-a
					    (angle pt-a pt-b)
					    height))))
			      (entdel l2)
			      )))))
	 ;; pt-b	 (if (> (sslength (setq ss (ssget "c" pt-b pt-b '((0 . "line"))))) 1)
	     (progn
	       (setq ss (ssdel line% ss))
	       (foreach l2 (pickset:to-list ss)
			(setq ang (abs (- (angle (entity:getdxf l2 10)
						(entity:getdxf l2 11))
					 (angle (entity:getdxf line% 10)
						(entity:getdxf line% 11)))))
			(while (> ang  pi)(setq ang (- ang pi)))
			
			(if (equal ang (* 0.5 pi) 0.07)
			    (progn
			      (if (> (distance (entity:getdxf l2 10) pt-b)
				     (* 0.5 width))
				  (progn
				    (entity:putdxf line% 11
						   (polar pt-b
							  (angle pt-b pt-a)
							  height))
				    (entity:make-line
				     (entity:getdxf l2 10)
				     (polar pt-b
					    (angle pt-b (entity:getdxf l2 10))
					    (* 0.5 width)))
				    (entity:make-line
				     (polar pt-b
					    (angle pt-b (entity:getdxf l2 10))
					    (* 0.5 width))
				     (polar pt-b
					    (angle pt-b pt-a)
					    height))
				    ))
			      (if (> (distance (entity:getdxf l2 11) pt-b)
				     (* 0.5 width))
				  (progn
				    (entity:make-line
				     (entity:getdxf l2 11)
				     (polar pt-b
					    (angle pt-b (entity:getdxf l2 11))
					    (* 0.5 width)))
				    (entity:make-line
				     (polar pt-b
					    (angle pt-b (entity:getdxf l2 11))
					    (* 0.5 width))
				     (polar pt-b
					    (angle pt-b pt-a)
					    height))))
			      (entdel l2)
			      )))))
	 
	 )))
  )

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

at-curve:notch

上传记录