一段代码问题求助

cheefeel

1. [code=lisp]
2. (defun C:DimOriginAlign (/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)
   
3.   (setvar "cmdecho" 0)
   
4.   (command "undo" "be")
   
5.   (while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))
   
6.   (if (setq PT1 (getpoint "指定标注引点对齐直线的第一点:"))
   
7.   (setq PT2 (getpoint PT1 "    指定第二点:"))
   
8.   (while (= ON NIL)
   
9.     (if (setq ENT (entsel "\n选择引点需对齐的直线"))
   
10.     (setq ON (assoc '0 (setq L1 (entget (car ENT))))))
    
11.     (if (= ON '(0 . "LINE"))
    
12.     (setq PT1 (cdr (assoc '10 L1))
    
13.         PT2 (cdr (assoc '11 L1)))
    
14.     (setq ON NIL))))
    
15.   (setq I 0)
    
16.   (while (setq DIM (ssname SS I))
    
17.   (setq DIMENT (entget DIM))
    
18.   (setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)
    
19.       PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)
    
20.       PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))
    
21.   (setq DIMENT
    
22.        (entmod
    
23.        (subst  (cons 13
    
24.               (trans (inters PT1
    
25.                      PT2
    
26.                      PT13
    
27.                      (polar PT13 (angle PT10 PT14) (distance PT10 PT14))
    
28.                      NIL)
    
29.                  1
    
30.                  0))
    
31.           (assoc 13 DIMENT)
    
32.           DIMENT)))
    
33.   (entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))
    
34.   (entupd DIM)
    
35.   (setq I (1+ I)))
    
36.   (command "undo" "e")
    
37.   (princ (strcat "\n共修改" (itoa I) "个标注，完毕！"))
    
38.   (princ))
    
39. (princ "\n加载引点对齐工具成功。命令:DimOriginAlign\n")

[code=lisp] (defun C:DimOriginAlign (/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)<br />   (setvar "cmdecho" 0)<br />   (command "undo" "be")<br />   (while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))<br />   (if (setq PT1 (getpoint "指定标注引点对齐直线的第一点:"))<br />   (setq PT2 (getpoint PT1 "    指定第二点:"))<br />   (while (= ON NIL)<br />     (if (setq ENT (entsel "\n选择引点需对齐的直线"))<br />     (setq ON (assoc '0 (setq L1 (entget (car ENT))))))<br />     (if (= ON '(0 . "LINE"))<br />     (setq PT1 (cdr (assoc '10 L1))<br />         PT2 (cdr (assoc '11 L1)))<br />     (setq ON NIL))))<br />   (setq I 0)<br />   (while (setq DIM (ssname SS I))<br />   (setq DIMENT (entget DIM))<br />   (setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)<br />       PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)<br />       PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))<br />   (setq DIMENT<br />        (entmod<br />        (subst  (cons 13<br />               (trans (inters PT1<br />                      PT2<br />                      PT13<br />                      (polar PT13 (angle PT10 PT14) (distance PT10 PT14))<br />                      NIL)<br />                  1<br />                  0))<br />           (assoc 13 DIMENT)<br />           DIMENT)))<br />   (entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))<br />   (entupd DIM)<br />   (setq I (1+ I)))<br />   (command "undo" "e")<br />   (princ (strcat "\n共修改" (itoa I) "个标注，完毕！"))<br />   (princ))<br /> (princ "\n加载引点对齐<a href="http://bbs.mjtd.com/forum-6-1.html" target="_blank" class="relatedlink">工具</a>成功。命令:DimOriginAlign\n")

[/code]







这是一个将标注的引出点对其于一条直线的工具代码，实际使用当中发现：可以指定两点来成功执行操作。但代码中有选择一条直线的功能，实际操作中按Enter后无法选中一条直线。请问其中的什么代码错了，希望有能力的朋友修正一下。

xyp1964

1. (defun c:tt (/ on)
   
2.   (while (not (setq ss (ssget '((0 . "DIMENSION"))))))
   
3.   (if (and (setq pt1 (getpoint "指定标注引点对齐直线的第一点<退出选线>: "))
   
4.            (setq pt2 (getpoint pt1 "指定第二点: "))
   
5.       )
   
6.     (setq on t)
   
7.     (while (= on nil)
   
8.       (if (setq s1 (car (entsel "\n选择引点需对齐的直线: ")))
   
9.         (setq on (assoc '0 (setq l1 (entget s1))))
   
10.       )
    
11.       (if (equal on '(0 . "LINE"))
    
12.         (setq pt1 (cdr (assoc '10 l1))
    
13.               pt2 (cdr (assoc '11 l1))
    
14.         )
    
15.         (setq on nil)
    
16.       )
    
17.     )
    
18.   )
    
19.   (setq i -1)
    
20.   (while (setq dim (ssname ss (setq i (1+ i))))
    
21.     (setq ent  (entget dim)
    
22.           pt10 (trans (cdr (assoc '10 ent)) 0 1)
    
23.           pt13 (trans (cdr (assoc '13 ent)) 0 1)
    
24.           pt14 (trans (cdr (assoc '14 ent)) 0 1)
    
25.           pt   (polar pt13 (angle pt10 pt14) (distance pt10 pt14))
    
26.           pt   (trans (inters pt1 pt2 pt13 pt nil) 1 0)
    
27.           ent  (entmod (subst (cons 13 pt) (assoc 13 ent) ent))
    
28.           pt   (trans (inters pt1 pt2 pt10 pt14 nil) 1 0)
    
29.           ent  (entmod (subst (cons 14 pt) (assoc 14 ent) ent))
    
30.     )
    
31.     (entupd dim)
    
32.   )
    
33.   (princ (strcat "\n共修改" (itoa i) "个标注，完毕！"))
    
34.   (princ)
    
35. )

(defun c:tt (/ on)<br />   (while (not (setq ss (ssget '((0 . "DIMENSION"))))))<br />   (if (and (setq pt1 (getpoint "指定标注引点对齐直线的第一点<退出选线>: "))<br />            (setq pt2 (getpoint pt1 "指定第二点: "))<br />       )<br />     (setq on t)<br />     (while (= on nil)<br />       (if (setq s1 (car (entsel "\n选择引点需对齐的直线: ")))<br />         (setq on (assoc '0 (setq l1 (entget s1))))<br />       )<br />       (if (equal on '(0 . "LINE"))<br />         (setq pt1 (cdr (assoc '10 l1))<br />               pt2 (cdr (assoc '11 l1))<br />         )<br />         (setq on nil)<br />       )<br />     )<br />   )<br />   (setq i -1)<br />   (while (setq dim (ssname ss (setq i (1+ i))))<br />     (setq ent  (entget dim)<br />           pt10 (trans (cdr (assoc '10 ent)) 0 1)<br />           pt13 (trans (cdr (assoc '13 ent)) 0 1)<br />           pt14 (trans (cdr (assoc '14 ent)) 0 1)<br />           pt   (polar pt13 (angle pt10 pt14) (distance pt10 pt14))<br />           pt   (trans (inters pt1 pt2 pt13 pt nil) 1 0)<br />           ent  (entmod (subst (cons 13 pt) (assoc 13 ent) ent))<br />           pt   (trans (inters pt1 pt2 pt10 pt14 nil) 1 0)<br />           ent  (entmod (subst (cons 14 pt) (assoc 14 ent) ent))<br />     )<br />     (entupd dim)<br />   )<br />   (princ (strcat "\n共修改" (itoa i) "个标注，完毕！"))<br />   (princ)<br /> )

cheefeel

xyp1964 发表于 2019-2-9 09:33

其实我根本不懂代码，这段代码是我第一次在明经求助得到的，用了起码7年以上，那时候还不是这个号。今天无意中发现还有对齐到一条直线的文字，就来提问一下。这个命令是超级实用的，我遇到的绝大部分设计师通过两种实现这样的目的，炸开并打断最拙劣，还有就是将标注样式设置卫固定长度。都很麻烦且不通用于不同情况。

alexmai

xyp1964 发表于 2019-2-9 09:33

超实用，点赞，点赞！

zmzk

楼主的这个程序和我下载这个“对齐线性标注”相似！

2. (defun C:DAG  (/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)
   
3.   (setvar "cmdecho" 0)
   
4. (setq oorth (getvar "ORTHOMODE"))
   
5. (setvar 'ORTHOMODE 1)
   
6.   (command "undo" "be")
   
7.   (while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))
   
8.   (if (setq PT1 (getpoint "指定线形标注对齐的直线第一点:<选择直线>"))
   
9.         (setq PT2 (getpoint PT1 "    第二点:"))
   
10.         (while (= ON NIL)
    
11.           (if (setq ENT (entsel "\n选择标注对齐的直线"))
    
12.                 (setq ON (assoc '0 (setq L1 (entget (car ENT))))))
    
13.           (if (= ON '(0 . "LINE"))
    
14.                 (setq PT1 (cdr (assoc '10 L1))
    
15.                           PT2 (cdr (assoc '11 L1)))
    
16.                 (setq ON NIL))))
    
17.   (setq I 0)
    
18.   (while (setq DIM (ssname SS I))
    
19.         (setq DIMENT (entget DIM))
    
20.         (setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)
    
21.                   PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)
    
22.                   PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))
    
23.         (setq DIMENT
    
24.                    (entmod
    
25.                          (subst        (cons 13
    
26.                                                   (trans (inters PT1
    
27.                                                                                  PT2
    
28.                                                                                  PT13
    
29.                                                                                  (polar PT13 (angle PT10 PT14) (distance PT10 PT14))
    
30.                                                                                  NIL)
    
31.                                                                  1
    
32.                                                                  0))
    
33.                                         (assoc 13 DIMENT)
    
34.                                         DIMENT)))
    
35.         (entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))
    
36.         (entupd DIM)
    
37.         (setq I (1+ I)))
    
38.   (command ".line" "" "")
    
39.   (command "undo" "e")
    
40. (setvar "ORTHOMODE" oorth)
    
41.   (princ (strcat "\n程序结束.共给更改了" (itoa I) "个标注."))
    
42.   (princ))
    
43. (princ "\n命令DAG---对齐线性标注.\n"))

(defun C:DAG  (/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)<br />   (setvar "cmdecho" 0)<br /> (setq oorth (getvar "ORTHOMODE"))<br /> (setvar 'ORTHOMODE 1)<br />   (command "undo" "be")<br />   (while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))<br />   (if (setq PT1 (getpoint "指定线形标注对齐的直线第一点:<选择直线>"))<br />         (setq PT2 (getpoint PT1 "    第二点:"))<br />         (while (= ON NIL)<br />           (if (setq ENT (entsel "\n选择标注对齐的直线"))<br />                 (setq ON (assoc '0 (setq L1 (entget (car ENT))))))<br />           (if (= ON '(0 . "LINE"))<br />                 (setq PT1 (cdr (assoc '10 L1))<br />                           PT2 (cdr (assoc '11 L1)))<br />                 (setq ON NIL))))<br />   (setq I 0)<br />   (while (setq DIM (ssname SS I))<br />         (setq DIMENT (entget DIM))<br />         (setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)<br />                   PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)<br />                   PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))<br />         (setq DIMENT<br />                    (entmod<br />                          (subst        (cons 13<br />                                                   (trans (inters PT1<br />                                                                                  PT2<br />                                                                                  PT13<br />                                                                                  (polar PT13 (angle PT10 PT14) (distance PT10 PT14))<br />                                                                                  NIL)<br />                                                                  1<br />                                                                  0))<br />                                         (assoc 13 DIMENT)<br />                                         DIMENT)))<br />         (entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))<br />         (entupd DIM)<br />         (setq I (1+ I)))<br />   (command ".line" "" "")<br />   (command "undo" "e")<br /> (setvar "ORTHOMODE" oorth)<br />   (princ (strcat "\n程序结束.共给更改了" (itoa I) "个标注."))<br />   (princ))<br /> (princ "\n命令DAG---对齐线性标注.\n"))