1. 当前位置: 首页 >> CAD插件 >>

    文字延直线方向的lisp程序

    0
    (VL-Load-Com)
    (defun c:ttt(/ Pt Pt1 Pt2 EntLine HandTxt VlaObj Tmp)
      (setq Pt1 (getpoint "n指定第一点:"))
      (setq Pt2 (getpoint "n指定下一点:"))
      (setq Pt (list (/ (+ (car Pt1) (car Pt2)) 2) (/ (+ (cadr Pt1) (cadr Pt2)) 2) (/ (+ (caddr Pt1) (caddr Pt2)) 2)))
      (command "._Line" Pt1 Pt2 "")
      (setq EntLine (entlast))
      (setq VlaObj (cons (VLAX-EName->VLA-Object EntLine) '()));;将直线转换为VLA对象
      
      (setq HandTxt '((0 . "TEXT"))
     HandTxt (append HandTxt (list (append '(10) Pt1)))
     HandTxt (append HandTxt (list (append '(11) Pt)))
     HandTxt (append HandTxt (list (cons 40 (getdist "n指定高度:"))))
     HandTxt (append HandTxt (list (cons 72  1)))
     HandTxt (append HandTxt (list (cons 73  0)))
     HandTxt (append HandTxt (list (cons 50 (angle pt1 Pt2))))
     HandTxt (append HandTxt (list (cons 1 (getstring "n输入文字:>")))))
      (entmake HandTxt)
      (setq HandTxt (cdr (Assoc 5 (entget (entlast)))))
      (VLR-Pers (VLR-Object-Reactor vlaObj HandTxt '((:vlr-modified . LineModefy))))
      )


    (defun LineModefy(EntLine EntTxt parameter-list / Pt Pt1 Pt2)
      (setq EntTxt (entget (HandEnt (VLR-Data EntTxt))))
      (setq EntLine (entget (VLAX-VLA-Object->EName EntLine)))
      (setq Pt1 (cdr (assoc 10 EntLine)) Pt2 (cdr (assoc 11 EntLine)))
      (setq Pt (list (/ (+ (car Pt1) (car Pt2)) 2) (/ (+ (cadr Pt1) (cadr Pt2)) 2) (/ (+ (caddr Pt1) (caddr Pt2)) 2)))
      (setq EntTxt (subst (cons 50 (angle Pt1 Pt2)) (assoc 50 EntTxt) EntTxt)
     EntTxt (subst (append '(10) Pt1) (assoc 10 EntTxt) EntTxt)
     EntTxt (subst (append '(11) Pt) (assoc 11 EntTxt) EntTxt))
      (entmod EntTxt)
    )
    
    Powered by DLKIT 开发版 © 2011-2012 DLCMS.NET Inc.
    Copyright © 2017-2018 威廉希尔_威廉希尔官网_英国威廉希尔官网