- ;按顺序提取单行文字
- (defun c:sxtqwz()
- (setq cmd (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (if (progn
- (princ "\n请选取多段线:")
- (setq ssa (ssget ":S" '((0 . "lwpolyline"))))
- )
- (progn
- (setq ent (ssname ssa 0))
- (setq dxf (entget ent))
- (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
- (setq ptmin (mapcar '+ (apply 'mapcar (cons 'min pts)) '(-100 -100)))
- (setq ptmax (mapcar '+ (apply 'mapcar (cons 'max pts)) '( 100 100)))
- (if (setq ssb (ssget "w" ptmin ptmax '((0 . "text"))))
- (progn
- (setq i 0)
- (setq n (sslength ssb))
- (setq jgb nil)
- (repeat n
- (setq entt (ssname ssb i))
- (setq dxft (entget entt))
- (setq pt (cdr (assoc 10 dxft)))
- (setq str (cdr (assoc 1 dxft)))
- (setq ptt (vlax-curve-getclosestpointto ent pt))
- (setq jgb (cons (list ptt str) jgb))
- (setq i (1+ i))
- )
- (setq jgb (vl-sort jgb '(lambda(a b)
- (< (vlax-curve-getdistatpoint ent (car a))
- (vlax-curve-getdistatpoint ent (car b))
- )
- )
- )
- )
- (foreach pt jgb
- (princ (strcat "\n" (cadr pt)))
- )
- )
- )
- )
- )
- (setvar "osmode" osm)
- (princ)
- )
命令: SXTQWZ
请选取多段线:
选择对象:
批注:变更13
批注:变更14
批注:变更15
批注:变更16
批注:变更17
批注:变更19
批注:变更18
批注:变更20
批注:变更21
批注:变更22
批注:变更23
批注:变更24 |