纯平民代码，弧形不适用，不知道有无bug
(defun c:tt5 (/ ang ename ent1 ent2 entdat p0 p1 pk pmid w)
(setq w t)
(while w
(if (setq ent1 (entsel "\n请选择对象<定点垂线>:"))
(progn (setq ename (car ent1)entdat(entget ename)pk (cadr ent1) p0 (osnap pk "_nea")p1 (getpoint"\n请输入垂线点:") ang (angle pk p0))
(command "line" "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang 1000) "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang -1000) ""));progn1
(progn (while (setq ent2 (entsel "\n请选择对象<中垂线>:"))
(setq ename (car ent2) entdat(entget ename) pk (cadr ent2) p0 (osnap pk "nea") pmid (osnap pk "mid") ang (angle pk p0))
(command "line" "non" (polar pmid ang 1000) "non" (polar pmid ang -1000) "")) (c:tt5));progn2
);if
);while
(princ)
)
start4444 发表于 2019-12-19 12:02
纯平民代码，弧形不适用，不知道有无bug
(defun c:tt5 (/ ang ename ent1 ent2 entdat p0 p1 pk...
经测验，完美运行，无BUG,比之前的的代码更简练了，哥们 你太牛了！！谢谢
start4444 发表于 2019-12-19 12:02
纯平民代码，弧形不适用，不知道有无bug
(defun c:tt5 (/ ang ename ent1 ent2 entdat p0 p1 pk...
(command "Selectioncycling" "0");ctrl/w關閉
(command "Selectioncycling" "2");ctrl/w打開
我想把这两句加进去，开头放上的管用，结尾放上的好像不起作用呀，加上这个函数避免重线的时候点选麻烦
代码是死循环，要按esc退出，最后面加个出错函数把参数恢复就行了
(defun *error* (msg) (command "Selectioncycling" "2") (princ "程序退出! "))
start4444 发表于 2019-12-19 12:51
代码是死循环，要按esc退出，最后面加个出错函数把参数恢复就行了
(defun *error* (msg) (command "Sele ...
原谅我有点笨 我试着换了好几个方式加上，都不行呢，复制的代码是最后一次实验的，在给看看吧
我尝试把末尾删掉只留你写的这句，也是没效果的，要不你加好再来段现成的吧，谢谢！
(defun c:HCX (/ ang ename ent1 ent2 entdat p0 p1 pk pmid w)
(command "Selectioncycling" "0");ctrl/w關閉
(setq w t)
(while w
(if (setq ent1 (entsel "\n請選擇對象<一般垂線>:"))
(progn (setq ename (car ent1)entdat(entget ename)pk (cadr ent1) p0 (osnap pk "_nea")p1 (getpoint"\n請輸入垂足:") ang (angle pk p0))
(command "line" "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang 1000) "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang -1000) ""));progn1
(progn (while (setq ent2 (entsel "\n請選擇對象<中垂線>:"))
(setq ename (car ent2) entdat(entget ename) pk (cadr ent2) p0 (osnap pk "nea") pmid (osnap pk "mid") ang (angle pk p0))
(command "line" "non" (polar pmid ang 1000) "non" (polar pmid ang -1000) "")) (c:HCX))
(defun *error* (msg) (command "Selectioncycling" "2") (princ "程序退出! "))
);if
);while
(princ)
)
xj6019 发表于 2019-12-19 13:10
原谅我有点笨 我试着换了好几个方式加上，都不行呢，复制的代码是最后一次实验的，在给看看吧
我尝试把 ...
(defun c:HCX (/ ang ename ent1 ent2 entdat p0 p1 pk pmid w)
(command "Selectioncycling" "0");ctrl/w關閉
(setq w t)
(while w
(if (setq ent1 (entsel "\n請選擇對象<一般垂線>:"))
(progn (setq ename (car ent1)entdat(entget ename)pk (cadr ent1) p0 (osnap pk "_nea")p1 (getpoint"\n請輸入垂足:") ang (angle pk p0))
(command "line" "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang 1000) "non" (polar (inters p1 (polar p1 ang -1000) pk (polar pk (+ ang (* 0.5 pi)) -1000) nil) ang -1000) ""));progn1
(progn (while (setq ent2 (entsel "\n請選擇對象<中垂線>:"))
(setq ename (car ent2) entdat(entget ename) pk (cadr ent2) p0 (osnap pk "nea") pmid (osnap pk "mid") ang (angle pk p0))
(command "line" "non" (polar pmid ang 1000) "non" (polar pmid ang -1000) "")) (c:HCX))
);if
);while
(princ)
) (defun *error* (msg) (command "Selectioncycling" "2") (princ "程序退出! "))
start4444 发表于 2019-12-19 13:49
(defun c:HCX (/ ang ename ent1 ent2 entdat p0 p1 pk pmid w)
(command "Selectioncycling" "0");ct ...
朋友谢谢了，不过ESC报错还是不行，算了不管这个了，这点问题不是问题了，完全不耽误使用，这问题略过吧
下面这个问题帮我看看好吗，这个一直想解决一下，发布的帖子都没一个人回复的，我觉得应该不费劲吧，布局的事我更不懂了，你看看，可以弄一下吗？
http://bbs.mjtd.com/thread-180617-1-1.html
start4444 发表于 2019-12-19 13:49
(defun c:HCX (/ ang ename ent1 ent2 entdat p0 p1 pk pmid w)
(command "Selectioncycling" "0");ct ...
大神好！请问加载后使用时提示文字乱码，有解决的办法吗？谢谢
© 2001-2013 Comsenz Inc.
适合标注和图块的状态