【源码】横断面点标注

;;;2026/6/12优化;;;XUYANYAN;;;(1)横断面标注主函数(vl-load-com)(defun c:DMBZ( / scd ck pt0 BH pt ent obj coords i)  (setq scd(getreal(strcat"\n 断面绘图比例尺1:<"(rtos(setq scd_bk(if scd_bk scd_bk 1))2 2)">")))  (if scd(setq scd_bk scd)(setq scd scd_bk))  (setq pt0 t)  (while pt0    (setq pt0(getpoint"\n 拾取中桩参考点 <Exit>："))    (if pt0(progn	     (setq Bh(getreal"\n 输入参考点高程(m)："))(initget"L l")	     (setq ck(getpoint"指定标注点或 [断面线(L)]:"))	     (if(and(/= ck "L")(/= ck "l"))	       ;;;标注点	       (progn(pdmmk pt0 ck)	       (while(setq pt(getpoint"\n 指定标注点:"))		 (pdmmk pt0 pt)))	       ;;;标注线	       (progn		 (setq ent(car(entsel "\n选定断面线:")))		 (if ent		   (progn		     (setq obj (vlax-ename->vla-object ent))		     (if (wcmatch (vla-get-objectname obj) "*Polyline")		       (progn			 (setq	coords(vlax-safearray->list					(vlax-variant-value					  (vla-get-coordinates obj))))			 (setq i 0)			 (repeat (/(length coords)2)			   (pdmmk pt0(list(nth i coords)(nth(1+ i)coords)0.0))			   (setq i(+ 2 i)))))))))))    (princ)))(prompt"\n输入命令\"DMBZ\"进行断面标注。");;;(2)点位注记子函数(defun Pdmmk(ptb pts / ofset dh)  (setq ofset(* scd(car (mapcar'- pts ptb)))	dh(+(* scd(cadr(mapcar'- pts ptb)))Bh))  (entmake(list'(0 . "LWPOLYLINE")	       '(100 . "AcDbEntity")	       '(100 . "AcDbPolyline")	       '(8 . "DMBZ")'(90 . 2)	       (cons 10 pts)'(40 . 0)'(41 . 0.2)	       (cons 10(mapcar'+ pts'(0 0.4)))))  (entmake(list '(0 . "MTEXT")		'(100 . "AcDbEntity")		'(100 . "AcDbMText")		'(71 . 4)'(7 . "HZ")		(cons 8 "DMBZ")		(cons 1(strcat"偏距:"(rtos ofset 2 3)"\\P高程:"(rtos dh 2 3)))		(cons 10(mapcar'+ pts'(0 0.5)))		'(40 . 0.35)'(44 . 0.9)		(cons 50(* 0.5 pi)))))