要求：放置点和累积
你好我正在寻找一个lisp/command，它可以在多段线上每隔X距离放置点和累积距离（文本）：
谢谢 试试看
(defun C:TEST ( / pline dist n pt )
(vl-load-com)
(and
(setq pline (ssget "_:S:E" '((0 . "*POLYLINE"))))
(setq pline (ssname pline 0))
(setq dist (getdist "\nEnter distance: "))
(setq n 0)
(while
(setq pt (vlax-curve-getPointAtDist pline (setq txt (* (setq n (1+ n)) dist))))
(point pt)
(text-entmake
(rtos
txt
2;;_decimal
2;;_precision
)
(mapcar '+ pt
'(0.5 -0.5) ;_ dX dY Text
)
1 ;_heigth
0 ;_rotation
nil;_justification
)
)
)
(princ)
)
(defun Point (pt)
(entmakex
(list (cons 0 "POINT")
(cons 10 pt)
)
)
)
(defun text-entmake (txt pnt height rotation justification / ent_list)
;;; borrowed from ShaggyDoc
;;; http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=23&TID=30276
;;; Draw text with entmake Lisp function
;;; Arguments:
;;; txt - text string
;;; pnt - point in WCS
;;; height - text height
;;; rotation - rotation angle
;;; justification - justification ("C" "R" "M" "A" "F") or nil
(setqent_list (list'(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(list 10 (car pnt) (cadr pnt) 0.0)
(cons 1 txt)
(cons 8 (getvar "CLAYER"))
(cons 40 height)
(cons 7 (getvar "TEXTSTYLE"))
(if justification
(cond
((= justification "C")
'(72 . 1)
)
((= justification "R")
'(72 . 2)
)
((= justification "A")
'(72 . 3)
)
((= justification "M")
'(72 . 4)
)
((= justification "F")
'(72 . 5)
)
(t
'(72 . 0)
)
) ;_ end of cond
'(72 . 0)
) ;_ end of if
(cons 50 rotation)
(cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "Style" (getvar "textstyle"))))))
(list 11 (car pnt) (cadr pnt) 0.0)
) ;_ end of list
) ;_ end of setq
(setq ent_list (entmakex ent_list))
)
效果很好！
非常感谢
页:
[1]