AutoLISP源码：自动绘制矩形的中心线

2022-02-24 AutoLISP

• 使用方法：输入系数，选择对象（可以框选）。
• 适用范围：AutoCAD R14-2022

;;{ ZZ-RCL }----------------------------------------------------;;
;;                                                              ;;
;; Creates a pair of centerlines for every selected Rectangles  ;;
;;--------------------------------------------------------------;;
;; Author: bati8888, Copyright  2022 - cad555.com               ;;
;;--------------------------------------------------------------;;
;; Version 1.0.0    -    2022-02-22                             ;;
;;--------------------------------------------------------------;;

(defun c:ZZ-RCL	(/	   factor    enfilter  eset	 cntr
		 en	   enlist    pt_list   a	 cen
		 pt1	   pt2	     pt3       pt4	 half_length1
		 half_length2	     c_layer
		)


    (if	(not (setq factor (getreal "请输入系数<1.2>")))
	(setq factor 1.2)
    )

    (if	(not (setq c_layer (getvar "CENTERLAYER")))
	(setq c_layer (getvar "CLAYER"))
    )
    (setq enfilter
	     '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))
    )

    (if	(setq eset (ssget enfilter))	;  if start   
	(progn				;  progn start
	    (setq cntr 0)
	    (while (< cntr (sslength eset)) ; while start
		(setq en      (ssname eset cntr)
		      enlist  (entget en)
		      pt_list nil
		)
		(foreach a enlist
		    ;;--- step through each sub-list
		    (if	(= 10 (car a))
			;;--- if the first item in the sub-list equals 10 then
			(setq pt_list ;;--- reset pt_list to
				      (append pt_list
					      ;;--- the old vertex list
					      (list ;;--- plus a list containing
						    (cdr a)
						    ;;--- the vertex point
					      )
					      ;;--- close the list
				      )
				      ;;--- close the append 
			)
			;;--- close the setq 
		    )
		    ;;--- close the if 
		)
		(setq pt1 (nth 0 pt_list)
		      pt2 (nth 1 pt_list)
		      pt3 (nth 2 pt_list)
		      pt4 (nth 3 pt_list)
		)
		(setq cen	   (inters pt1 pt3 pt2 pt4 nil)
		      half_length1
				   (* (/ (distance pt1 pt2) 2) factor)
		      half_length2
				   (* (/ (distance pt2 pt3) 2) factor)
		)
		(setq pt1 (polar cen 0 half_length1)
		      pt2 (polar cen pi half_length1)
		      pt3 (polar cen (/ pi 2) half_length2)
		      pt4 (polar cen (- 0 (/ pi 2)) half_length2)
		)
		(entmake (list '(0 . "LINE")
			       (cons 10 pt1)
			       (cons 11 pt2)
			       (cons 8 c_layer)
			 )
		)
		(entmake (list '(0 . "LINE")
			       (cons 10 pt3)
			       (cons 11 pt4)
			       (cons 8 c_layer)
			 )
		)
		(setq cntr (1+ cntr)
		)

	    )				; while  
	    (princ (strcat "\n共处理" (itoa cntr) "个矩形。\n"))
	)				; progn end 
	(princ "\n 没有选择对象。\n")
    )					; if end
    (princ)
)