Tharwat 发表于 2022-7-6 07:59:16

Alternative one if you are interested .
 

(defun c:Test (/ _Text s);;; Tharwat 23. Dec. 2012 ;;; (defun _Text (p a d)   (entmakex (list '(0 . "TEXT")                   (cons 10 (trans p 1 0))                   (cons 11 (trans p 1 0))                   (cons 1 (rtos d 2))                   (cons 50 a)                   '(40 . 2.)                   (cons 7 (getvar 'textstyle))                   '(71 . 0)                   '(72 . 1)             )   ) ) (if (setq s (ssget '((0 . "LINE,LWPOLYLINE"))))   ((lambda (i / e sn pt p p1 p2 st nd ang)      (while (setq sn (ssname s (setq i (1+ i))))      (setq e (entget sn))      (if (eq (cdr (assoc 0 e)) "LWPOLYLINE")          (progn (setq pt 0)               (repeat (- (fix (vlax-curve-getendparam sn)) (fix (vlax-curve-getstartparam sn)))                   (setq p (mapcar (function (lambda (j k) (/ (+ j k) 2.)))                                 (setq p1 (vlax-curve-getpointatparam sn pt))                                 (setq p2 (vlax-curve-getpointatparam sn (setq pt (1+ pt))))                           )                   )                   (_Text p (angle p1 p2) (distance p1 p2))               )          )          (progn (setq ang (angle (setq st (cdr (assoc 10 e))) (setq nd (cdr (assoc 11 e)))))               (_Text (mapcar (function (lambda (j k) (/ (+ j k) 2.))) st nd) ang (distance st nd))          )      )      )    )   -1   ) ) (princ))

gS7 发表于 2022-7-6 08:06:17

Very nice !! tank you Tharwat

Tharwat 发表于 2022-7-6 08:08:35

 
You're welcome .
页: 1 [2]
查看完整版本: 我的Lisp程序需要什么帮助