一段代码问题求助
本帖最后由 cheefeel 于 2019-2-8 17:10 编辑(defun C:DimOriginAlign (/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)
(setvar "cmdecho" 0)
(command "undo" "be")
(while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))
(if (setq PT1 (getpoint "指定标注引点对齐直线的第一点:"))
(setq PT2 (getpoint PT1 " 指定第二点:"))
(while (= ON NIL)
(if (setq ENT (entsel "\n选择引点需对齐的直线"))
(setq ON (assoc '0 (setq L1 (entget (car ENT))))))
(if (= ON '(0 . "LINE"))
(setq PT1 (cdr (assoc '10 L1))
PT2 (cdr (assoc '11 L1)))
(setq ON NIL))))
(setq I 0)
(while (setq DIM (ssname SS I))
(setq DIMENT (entget DIM))
(setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)
PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)
PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))
(setq DIMENT
(entmod
(subst(cons 13
(trans (inters PT1
PT2
PT13
(polar PT13 (angle PT10 PT14) (distance PT10 PT14))
NIL)
1
0))
(assoc 13 DIMENT)
DIMENT)))
(entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))
(entupd DIM)
(setq I (1+ I)))
(command "undo" "e")
(princ (strcat "\n共修改" (itoa I) "个标注，完毕！"))
(princ))
(princ "\n加载引点对齐工具成功。命令:DimOriginAlign\n")
这是一个将标注的引出点对其于一条直线的工具代码，实际使用当中发现：可以指定两点来成功执行操作。但代码中有选择一条直线的功能，实际操作中按Enter后无法选中一条直线。请问其中的什么代码错了，希望有能力的朋友修正一下。
(defun c:tt (/ on)
(while (not (setq ss (ssget '((0 . "DIMENSION"))))))
(if (and (setq pt1 (getpoint "指定标注引点对齐直线的第一点<退出选线>: "))
(setq pt2 (getpoint pt1 "指定第二点: "))
)
(setq on t)
(while (= on nil)
(if (setq s1 (car (entsel "\n选择引点需对齐的直线: ")))
(setq on (assoc '0 (setq l1 (entget s1))))
)
(if (equal on '(0 . "LINE"))
(setq pt1 (cdr (assoc '10 l1))
pt2 (cdr (assoc '11 l1))
)
(setq on nil)
)
)
)
(setq i -1)
(while (setq dim (ssname ss (setq i (1+ i))))
(setq ent(entget dim)
pt10 (trans (cdr (assoc '10 ent)) 0 1)
pt13 (trans (cdr (assoc '13 ent)) 0 1)
pt14 (trans (cdr (assoc '14 ent)) 0 1)
pt (polar pt13 (angle pt10 pt14) (distance pt10 pt14))
pt (trans (inters pt1 pt2 pt13 pt nil) 1 0)
ent(entmod (subst (cons 13 pt) (assoc 13 ent) ent))
pt (trans (inters pt1 pt2 pt10 pt14 nil) 1 0)
ent(entmod (subst (cons 14 pt) (assoc 14 ent) ent))
)
(entupd dim)
)
(princ (strcat "\n共修改" (itoa i) "个标注，完毕！"))
(princ)
) xyp1964 发表于 2019-2-9 09:33
其实我根本不懂代码，这段代码是我第一次在明经求助得到的，用了起码7年以上，那时候还不是这个号。今天无意中发现还有对齐到一条直线的文字，就来提问一下。这个命令是超级实用的，我遇到的绝大部分设计师通过两种实现这样的目的，炸开并打断最拙劣，还有就是将标注样式设置卫固定长度。都很麻烦且不通用于不同情况。 xyp1964 发表于 2019-2-9 09:33
超实用，点赞，点赞！ 楼主的这个程序和我下载这个“对齐线性标注”相似！(defun C:DAG(/ SS PT1 PT2 ON L1 DIM I DIMENT ENT PT10 PT13 PT14)
(setvar "cmdecho" 0)
(setq oorth (getvar "ORTHOMODE"))
(setvar 'ORTHOMODE 1)
(command "undo" "be")
(while (= SS NIL) (setq SS (ssget '((0 . "DIMENSION")))))
(if (setq PT1 (getpoint "指定线形标注对齐的直线第一点:<选择直线>"))
(setq PT2 (getpoint PT1 " 第二点:"))
(while (= ON NIL)
(if (setq ENT (entsel "\n选择标注对齐的直线"))
(setq ON (assoc '0 (setq L1 (entget (car ENT))))))
(if (= ON '(0 . "LINE"))
(setq PT1 (cdr (assoc '10 L1))
PT2 (cdr (assoc '11 L1)))
(setq ON NIL))))
(setq I 0)
(while (setq DIM (ssname SS I))
(setq DIMENT (entget DIM))
(setq PT10 (trans (cdr (assoc '10 DIMENT)) 0 1)
PT13 (trans (cdr (assoc '13 DIMENT)) 0 1)
PT14 (trans (cdr (assoc '14 DIMENT)) 0 1))
(setq DIMENT
(entmod
(subst (cons 13
(trans (inters PT1
PT2
PT13
(polar PT13 (angle PT10 PT14) (distance PT10 PT14))
NIL)
1
0))
(assoc 13 DIMENT)
DIMENT)))
(entmod (subst (cons 14 (trans (inters PT1 PT2 PT10 PT14 NIL) 1 0)) (assoc 14 DIMENT) DIMENT))
(entupd DIM)
(setq I (1+ I)))
(command ".line" "" "")
(command "undo" "e")
(setvar "ORTHOMODE" oorth)
(princ (strcat "\n程序结束.共给更改了" (itoa I) "个标注."))
(princ))
(princ "\n命令DAG---对齐线性标注.\n"))
页:
[1]