[LISP程序]：提供一个“文字与直线平行程”的实用程序,欢迎大家提意见

xxming

(defun c:test()
  (setq pt1 (getpoint "\n选择直线的第一点"))
  (setq pt2 (getpoint pt1 "\n选择直线的第二点"))
  (setq ang (angle pt1 pt2))
  (setq ss (ssget '((0 . "text"))))
  (setq i -1)
  (while   (setq en (ssname ss (setq i (1+ i))))
           (setq ddate (entget en))
           (setq pt (cdr (assoc 10 ddate)))
           (setq jd (cdr(assoc 50 ddate)))
           (command "select" "l" "")
           (command "rotate" ss "" pt (angtos(- ang jd)0 2))
     
  )
  )
(prompt "\n文字与直线平行程序，键入：test执行---------------程序设计：小谢")
(princ)

f5612140

1.不先鎖點"端點"會有誤差
2.選直線求ang就好了,不需點二點再求ang

kailler

我以前也写过一样的东西，当初我的输入是一条线取dxf 10 ,11,判断转角避免倒字，用entmode更新50（我想速度可以快点），避免捕捉的保存,我找到代码了
(DEFUN C:RR (/ LINEENT TEXTENT LINEANGLE PTS PTE)
  (SETQ LINEENT (ENTSEL))
  (IF LINEENT
   (PROGN
      (SETQ LINEENT (ENTGET (CAR LINEENT)))
      (IF (= "LINE" (DXF 0 LINEENT))
        (PROGN
          (SETQ PTS (DXF 10 LINEENT))
          (SETQ PTE (DXF 11 LINEENT))
          (SETQ LINEANGLE (ANGLE PTS PTE))
          (IF (> LINEANGLE (/ PI 2.0)) (SETQ LINEANGLE (- LINEANGLE Pi)))
          (IF (> LINEANGLE (/ PI 2.0)) (SETQ LINEANGLE (- LINEANGLE Pi)))
          (SETQ TEXTENT (ENTSEL "\nTEXT"))
          (IF TEXTENT
              (PROGN
                (SETQ TEXTENT (ENTGET (CAR TEXTENT)))
                (SETQ TEXTENT (SUBST (CONS 50 LINEANGLE) (ASSOC 50 TEXTENT) TEXTENT))
                (Ai_UNDO_PUSH)
                (ENTMOD TEXTENT)
                (AI_UNDO_POP)
              );PROGN
          );IF
        );PROGN
      );IF
    );PROGN
  );FI
);DEFUN

xxming

是test执行

ss1025

用entsel选直线，然后用组码10，11来取端点，不要用getpoint。
而且，在angle中要判断直线的角度，要不然会出现倒字的。

saoaduan

2楼楼主说：   9pt 10pt 11pt 12pt 13pt 15pt  

1.不先鎖點"端點"會有誤差
2.選直線求ang就好了,不需點二點再求ang  


如果对象是多义线，又该如何？？？、

ljpnb

如果是两点连线的多义线，也可以直接由两点来ang，2楼提得第2点还是有道理的，而且实际操作也应该如此。另外还需要考虑一点，就是如果空选，则采用1楼楼主的操作，选择两点，我认为一个好的程序，就应该尽可能适合于不同情况下的操作。
以下程序是我修改过的，暂不支持多义线：
(defun c:test ()
  (setq ss (ssget '((0 . "text"))))
  (if (/= (setq ent (car (entsel "\n选择一条直线: "))) nil)
    (progn
      (setq obj (vlax-ename->vla-object ent))
      (setq ang (vla-get-Angle obj))
    )
    (progn
      (setq pt1 (getpoint "\n选择对齐的第一点"))
      (setq pt2 (getpoint pt1 "\n选择对齐的第二点"))
      (setq ang (angle pt1 pt2))
    )
  )
  (cond        ((and (> ang (* pi 0.5)) (< ang pi))
         (setq ang (+ ang pi))
        )
        ((and (> ang pi) (< ang (* pi 1.5)))
         (setq ang (- ang pi))
        )
        ((= ang pi) (setq ang 0))
        ((= ang (* pi 1.5)) (setq ang (* pi 0.5)))
        (T (setq ang ang))
  )
  (setq        len (sslength ss)
        i   0
  )
  (repeat len
    (setq ent1 (ssname ss i))
    (setq obj1 (vlax-ename->vla-object ent1))
    (vla-put-Rotation obj1 ang)
    (setq i (1+ i))
  )
  (princ)
)

sdwy19691229

个人认为点选直线会好些!
其他问题,可慢慢解决.

xxming

;对三楼程序稍修改,支持多义线，大家提提意见
(DEFUN C:test(/ LINEENT TEXTENT LINEANGLE PTS PTE)
(SETQ LINEEN (ENTSEL))
(if (= (cdr(assoc 0 (entget(car lineen)))) "LWPOLYLINE")
   (PROGN
     (command "explode" (car lineen) "")
     (alert "\n将多义线分解,请选择直线")
     (SETQ LINEEN (ENTSEL"\n选择直线"))
     (redraw (car lineen) 3)
     (IF LINEEN
       (PROGN
       (SETQ LINEENT (ENTGET (CAR LINEEN)))
       (SETQ PTS (cdr(assoc 10 LINEENT)))
       (SETQ PTE (cdr(assoc 11 LINEENT)))
       (SETQ LINEANGLE (ANGLE PTS PTE))
       (SETQ TEXTEN (ENTSEL "\n选择文字"))
       (redraw (car lineen) 4)
       (IF TEXTEN
          (PROGN
          (setq obj (vlax-ename->vla-object (car texten)))
          (vla-put-rotation obj LINEANGLE)
       )))))
   (progn
       (redraw (car lineen) 3)
       (SETQ LINEENT (ENTGET (CAR LINEEN)))
       (SETQ PTS (cdr(assoc 10 LINEENT)))
       (SETQ PTE (cdr(assoc 11 LINEENT)))
       (SETQ LINEANGLE (ANGLE PTS PTE))
       (SETQ TEXTEN (ENTSEL "\n选择文字"))
       (redraw (car lineen) 4)
       (IF TEXTEN
          (PROGN
          (setq obj (vlax-ename->vla-object (car texten)))
          (vla-put-rotation obj LINEANGLE)
       ))))
(princ));DEFUN

kailler

其实这个编程实现很简单，即使手改也不慢，主要是看看理论上是否完善
我会用LISP时V-LISP，VBA刚出FOR 14的时候，现在也很少用ACAD了,所以一直对V-LISP没有研究，好像LISP差不多也够用了
“vlax-ename->vla-object “难道V-LISP可以进行指针操作？

njshf

关键是找到直线或多一线的两个端点。

木子涛

首先楼主及朋友的辛勤劳动，其实expresstools里面就有文字和其它对象对齐的命令。
TORIENT

ss1025

嗯，探索中的文字平行就很强啊，还可以实时拖动显示呢。