AutoLISP源码：改进的画圆中心程序

2021-11-04 AutoLISP

AutoCAD 2017以上新版本中有CENTERMARK命令和CENTEREXE系统变量，但也有限制：中心线长度中心线超出直径部分的长度是按值（CENTEREXE）设定的。本人改进了一下，通过一个系数（中心线和直径的比）控制中心线长度，通过框选、单选都可以，一次画出所选多个圆（圆弧）的中心线，并且线长可定制：输入系数（默认为1.2）为线长和圆（或圆弧）的比值。适用于AutoCAD R14-2022版本。

;;{ ZZ-CCL }--------------------------------------------------------;;
;;                                                                  ;;
;;  Creates a pair of centerlines for every selected Arcs, Circles  ;;
;;                                                                  ;;
;;------------------------------------------------------------------;;
;;  Author: bati8888, Copyright  2021 - cad555.com                  ;;
;;------------------------------------------------------------------;;
;;  Version 1.0.1    -    2021-03-24                                ;;
;;------------------------------------------------------------------;;

(defun c:ZZ-CCL	(/	  factor   enfilter eset     cntr     en
		 enlist	  cen	   radius   pt1	     pt2      pt3
		 pt4	  half_length	    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
	     '((-4 . "<or") (0 . "circle") (0 . "arc") (-4 . "or>"))
    )

    (if	(setq eset (ssget enfilter))	;  if start   
	(progn				;  progn start
	    (setq cntr 0)
	    (while (< cntr (sslength eset)) ; while start
		(setq en (ssname eset cntr))
		(setq enlist (entget en))
		(setq cen (cdr (assoc 10 enlist)))
		(setq radius (cdr (assoc 40 enlist)))
		(setq half_length (* radius factor)
		      pt1	  (polar cen 0 half_length)
		      pt2	  (polar cen pi half_length)
		      pt3	  (polar cen (/ pi 2) half_length)
		      pt4	  (polar cen (* pi 1.5) half_length)
		)
		(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)
)