[编程交流] 链测长度lisp到等高线标签

6

;;;;;CONTOUR LABELING;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;based on chainage lisp posted by sean.keohane ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;[color="red"](setq *dist* 100.) ; default[/color](defun c:cl (/ dist height to ss count height ent obj chainage p p2 len obj bearing); vla-object ent)    chainage *dist*    ) ;_ end of setq     (setq p (vlax-curve-getstartpoint obj))     (setq p2 (vlax-curve-getendpoint obj));;;;added by rrulep to label the end points of polyline[color="blue"];;added by hanhphuc if interval > length, (if.. progn..)[/color][color="red"]      (setq len (vlax-curve-getDistAtPoint obj p2))     (if (>= *dist* len)(mapcar        ''((x)           (_text            x            (_ang x (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj p) 0.001)))            to            (* height 10. (/ (getvar 'viewsize) (cadr (getvar 'screensize))))            (caddr x)            )           )        (list p (vlax-curve-getPointAtDist obj (/ len 2)) p2)        ) ;_ end of mapcar[/color][color="red"](progn [/color](setq bearing (_ang p (vlax-curve-getPointAtDist obj (+ chainage 0.001))))       (_text p bearing to height (caddr p));;;;modified by mircea to get the elevation value of polyline       (_text p2 bearing to height (caddr p));;;;added by rrulep to label the end points of polyline       (while (and (setq point1 (vlax-curve-getPointAtDist obj chainage))                   (setq point2 (vlax-curve-getPointAtDist obj (+ chainage 0.001)))                   ) ;_ end of and         (setq bearing (+ (angle point1 point2) (/ (* 3 PI) 2.0)))         (_text point1 bearing to height (caddr point1));;;;modified by mircea to get the elevation value of polyline         (setq chainage (+ chainage *dist*))         ) ;_ end of while       (setq count (1+ count))[color="red"]       ) ;_ end of progn) ;_ end of if[/color]     ) ;_ end of repeat   ) ;_ end of if ) ;_ end of defun