本帖最后由 wzg356 于 2014-12-24 12:48 编辑
现写的,将就练手- ;wzg 356 于20141222
- ;;;文字达到齐线效果,文字与直线角度一致后,想放哪儿就放哪儿。
- (defun c:tt3 ( / PickSegEndPt en1 en2 enl1 enl2 p1 p2 p1p2 gr gr-model gr-value tmp)
- ;;多段线所点击子段的两端点列表,from 明经
- (defun PickSegEndPt (obj p / pp n)
- (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
- n (fix (vlax-curve-getparamatpoint obj pp)))
- (list (vlax-curve-getPointAtParam obj n)
- (vlax-curve-getPointAtParam obj (1+ n)))
- )
- (while
- (not(and
- (setq en1 (entsel "\n选择单行文字:"))
- (= (cdr (assoc 0 (setq enl1(entget(car en1))))) "TEXT")
- )
- )
- )
- (while
- (not(wcmatch
- (cdr(assoc 0(setq enl2(entget(car (setq en2 (entsel "\n选择直线...")))))))
- "*LINE"
- )
- )
- )
- (if (= (cdr (assoc 0 enl2)) "LINE")
- (setq p1 (cdr (assoc 10 enl2))
- p2 (cdr (assoc 11 enl2))
- )
- (progn
- (setq p1p2(PickSegEndPt (car en2) (cadr en2)))
- (setq p1 (car p1p2)
- p2 (cadr p1p2)
- )
- )
- )
- (if(or(> (car p1) (car p2))
- (and
- (equal (car p1) (car p2) 0.00001)
- (> (cadr p1) (cadr p2))
- ))
- (setq tmp p2
- p2 p1
- p1 tmp
- )
- )
- (setq enl1 (subst (cons 50 (angle p1 p2)) (assoc 50 enl1) enl1)
- enl1 (subst (cons 72 0) (assoc 72 enl1) enl1)
- enl1 (subst (cons 73 0) (assoc 73 enl1) enl1)
- )
- (princ "\n请摆放在恰当位置:")
- (setq gr 0 gr-model 0 gr-value 0 )
- (while (/= gr-model 3)
- (setq gr (grread T 8)
- gr-model (car gr)
- gr-value (cadr gr)
- )
- (if (and gr (= gr-model 5))
- (entmod (subst (cons 10 gr-value) (assoc 10 enl1) enl1))
- )
- )
- (PRINC)
- )
|