直线，长度可以按某长度倍数输入

hubeiwdlue

日常绘图的时候，时常有一个困扰，就是一个图纸上，有几个不同比例尺的图，有的绘图比例是1:1000，有的是1:500等，这个时候，总要按计算器来确定绘制直线的长度。本来想在论坛上找一个代替line的命令，可以直接在输入长度时候输入算式，或者有几倍长度的选项，但是没有找到。自己刚开始学，也没能力做出来。就写了一个弱化版的line，凑合用，可以在上下左右四个方向生成直线，长度有两个输入项，长度和倍数。输入第二个点时候，如果直接按空格，则进入倍数模式。

我不清楚这个功能的插件是难还是简单，如果有大神做出来，那就不胜感激了。

2. ;;生成直线
   
3. (defun entmakeline (p1 p2)
   
4.   (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2)))
   
5. )
   
6. 
   
7. ;;8等分象限函数
   
8. ;;p0 定点  p1 位置落在不同象限，返回 11 12 21 22 31 32 41 41,靠近x轴后缀是1，y轴后缀是2
   
9. (defun sl-8p (p0 p1 / ang xx) ;;象限
   
10.   (setq ang (angle p0 p1))
    
11.   (cond
    
12.     ((and (<= ang (* 0.25 pi)) (> ang 0)) (setq xx 11))
    
13.     ((and (<= ang (* 0.5 pi)) (> ang (* 0.25 pi))) (setq xx 12))
    
14.     ((and (<= ang (* 0.75 pi)) (> ang (* 0.5 pi))) (setq xx 22))
    
15.     ((and (<= ang (* 1 pi)) (> ang (* 0.75 pi))) (setq xx 21))
    
16.     ((and (<= ang (* 1.25 pi)) (> ang (* 1 pi))) (setq xx 31))
    
17.     ((and (<= ang (* 1.5 pi)) (> ang (* 1.25 pi))) (setq xx 32))
    
18.     ((and (<= ang (* 1.75 pi)) (> ang (* 1.5 pi))) (setq xx 42))
    
19.     ((and (<= ang (* 2 pi)) (> ang (* 1.75 pi))) (setq xx 41))
    
20.   )
    
21.   xx
    
22. )
    
23. 
    
24. ;;主函数
    
25. (defun c:ll(/ p1 p2 p3 p4 bb dis n1 xx)
    
26.   (setq p1 (getpoint "\n第一个点"))
    
27.   (setq p2 (getpoint p1 "\n第二个点"))
    
28.   (if (/= p2 nil)
    
29.     (entmakeline (trans p1 1 0) (trans p2 1 0))
    
30.     (progn
    
31.       (setq bb (grread t 8 0) p3 (cadr bb))
    
32.       (setq dis (getdist p1 "\n输入距离"))
    
33.       (setq n1 (getreal "\n输入倍数"))
    
34.       (setq xx (sl-8p p1 p3))
    
35.       (cond
    
36.         ((or (= xx 11) (= xx 41)) (setq ang 0))
    
37.         ((or (= xx 12) (= xx 22)) (setq ang (* 0.5 pi)))
    
38.         ((or (= xx 21) (= xx 31)) (setq ang pi))
    
39.         ((or (= xx 32) (= xx 42)) (setq ang (* 1.5 pi)))
    
40.       )
    
41.     (setq p4 (polar p1 ang (* dis n1)))
    
42.     (entmakeline (trans p1 1 0) (trans p4 1 0))
    
43.     )
    
44.   )
    
45.   (princ)
    
46. )

;;生成直线<br /> (defun entmakeline (p1 p2)<br />   (entmakex (list '(0 . "line") (cons 10 p1) (cons 11 p2)))<br /> )<br /> <br /> ;;8等分象限函数<br /> ;;p0 定点  p1 位置落在不同象限，返回 11 12 21 22 31 32 41 41,靠近x轴后缀是1，y轴后缀是2<br /> (defun sl-8p (p0 p1 / ang xx) ;;象限<br />   (setq ang (angle p0 p1))<br />   (cond<br />     ((and (<= ang (* 0.25 pi)) (> ang 0)) (setq xx 11))<br />     ((and (<= ang (* 0.5 pi)) (> ang (* 0.25 pi))) (setq xx 12))<br />     ((and (<= ang (* 0.75 pi)) (> ang (* 0.5 pi))) (setq xx 22))<br />     ((and (<= ang (* 1 pi)) (> ang (* 0.75 pi))) (setq xx 21))<br />     ((and (<= ang (* 1.25 pi)) (> ang (* 1 pi))) (setq xx 31))<br />     ((and (<= ang (* 1.5 pi)) (> ang (* 1.25 pi))) (setq xx 32))<br />     ((and (<= ang (* 1.75 pi)) (> ang (* 1.5 pi))) (setq xx 42))<br />     ((and (<= ang (* 2 pi)) (> ang (* 1.75 pi))) (setq xx 41))<br />   )<br />   xx<br /> )<br /> <br /> ;;主函数<br /> (defun c:ll(/ p1 p2 p3 p4 bb dis n1 xx)<br />   (setq p1 (getpoint "\n第一个点"))<br />   (setq p2 (getpoint p1 "\n第二个点"))<br />   (if (/= p2 nil)<br />     (entmakeline (trans p1 1 0) (trans p2 1 0))<br />     (progn<br />       (setq bb (grread t 8 0) p3 (cadr bb))<br />       (setq dis (getdist p1 "\n输入距离"))<br />       (setq n1 (getreal "\n输入倍数"))<br />       (setq xx (sl-8p p1 p3))<br />       (cond <br />         ((or (= xx 11) (= xx 41)) (setq ang 0))<br />         ((or (= xx 12) (= xx 22)) (setq ang (* 0.5 pi)))<br />         ((or (= xx 21) (= xx 31)) (setq ang pi))<br />         ((or (= xx 32) (= xx 42)) (setq ang (* 1.5 pi)))<br />       )<br />     (setq p4 (polar p1 ang (* dis n1)))<br />     (entmakeline (trans p1 1 0) (trans p4 1 0))<br />     )<br />   )<br />   (princ)<br /> )

kucha007

试试这个：
建议还是1：1制图，大不了编块放大或者用布局。要不然比例丢失绘制对不上会很麻烦

1. (defun c:TT (/ DOC Old_CMD TmpVar P1 P2 Flag StaPT EndPT)
   
2.   (setq DOC (vla-get-ActiveDOCument (vlax-get-acad-object)))
   
3.   (defun *error*(msg)
   
4.     (setvar "cmdecho" Old_CMD)
   
5.     (vla-endundomark DOC)
   
6.   )
   
7.   (vla-startundomark Doc) ;记录编组
   
8.     (setq Old_CMD (getvar "cmdecho"))(setvar "cmdecho" 0) ;关闭回显
   
9.     (if (not Global:SCSVar)(setq Global:SCSVar 1.0));设置首次为1
   
10.     (while
    
11.       (progn
    
12.         (initget 2 "R S");非零
    
13.         (setq TmpVar (getpoint (strcat "\n→请输入起点或:[参照(R)/比例(S)_" (rtos Global:SCSVar 2 2)"]")))
    
14.         (cond
    
15.           ((and (eq (type TmpVar) 'STR)(eq (strcase TmpVar) "R"))
    
16.             (if (setq P1 (getpoint "\n→请指定第一点:")
    
17.                       P2 (getpoint P1 "\n→请指定第二点:")
    
18.                 )
    
19.                 (setq Global:SCSVar (/ (getdist P1 "\n→请输入或量取新的长度:") (distance P1 P2)))
    
20.             )
    
21.             T ;继续循环
    
22.           )
    
23.           ((and (eq (type TmpVar) 'STR)(eq (strcase TmpVar) "S"))
    
24.               (initget (+ 2 4));非零非负
    
25.               (setq Global:SCSVar
    
26.                   (cond
    
27.                     ((getreal (strcat "\n→请输入缩放的值:<" (rtos Global:SCSVar 2 2) ">: ")))
    
28.                     (Global:SCSVar)
    
29.                   )
    
30.               )
    
31.               T ;继续循环
    
32.           )
    
33.           ((and TmpVar (eq (type TmpVar) 'LIST))
    
34.               (setq StaPT TmpVar
    
35.                     Flag T ;循环标志
    
36.               )
    
37.               (while Flag
    
38.                 (if (setq EndPT (getpoint StaPT "\n→请输入下一个点:"))
    
39.                     (progn
    
40.                       (setq EndPT (polar StaPT (angle StaPT EndPT) (* Global:SCSVar (distance StaPT EndPT))));放大后的点
    
41.                       (command "_Line" StaPT EndPT "")
    
42.                       (setq StaPT EndPT)
    
43.                     )
    
44.                     (progn
    
45.                       (setq Flag Nil);退出循环
    
46.                       (princ "\n——★★★ 未输入下一点, 程序退出！★★★——")
    
47.                     )   
    
48.                 )
    
49.               )
    
50.               nil ;退出循环
    
51.           )
    
52.           (T
    
53.               (princ "\n——★★★ 请输入起点或者关键词！★★★——")
    
54.               nil ;退出循环
    
55.           )
    
56.         )
    
57.       )  
    
58.     )
    
59.     (setvar "cmdecho" Old_CMD)
    
60.   (vla-endundomark Doc) ;结束编组
    
61.   (princ)
    
62. )
    

(defun c:TT (/ DOC Old_CMD TmpVar P1 P2 Flag StaPT EndPT)<br />   (setq DOC (vla-get-ActiveDOCument (vlax-get-acad-object)))<br />   (defun *error*(msg)<br />     (setvar "cmdecho" Old_CMD)<br />     (vla-endundomark DOC)<br />   )<br />   (vla-startundomark Doc) ;记录编组<br />     (setq Old_CMD (getvar "cmdecho"))(setvar "cmdecho" 0) ;关闭回显<br />     (if (not Global:SCSVar)(setq Global:SCSVar 1.0));设置首次为1<br />     (while<br />       (progn<br />         (initget 2 "R S");非零<br />         (setq TmpVar (getpoint (strcat "\n→请输入起点或:[参照(R)/比例(S)_" (rtos Global:SCSVar 2 2)"]")))<br />         (cond<br />           ((and (eq (type TmpVar) 'STR)(eq (strcase TmpVar) "R"))<br />             (if (setq P1 (getpoint "\n→请指定第一点:")<br />                       P2 (getpoint P1 "\n→请指定第二点:")<br />                 )<br />                 (setq Global:SCSVar (/ (getdist P1 "\n→请输入或量取新的长度:") (distance P1 P2)))<br />             )<br />             T ;继续循环<br />           )<br />           ((and (eq (type TmpVar) 'STR)(eq (strcase TmpVar) "S"))<br />               (initget (+ 2 4));非零非负<br />               (setq Global:SCSVar <br />                   (cond <br />                     ((getreal (strcat "\n→请输入缩放的值:<" (rtos Global:SCSVar 2 2) ">: ")))<br />                     (Global:SCSVar)<br />                   )<br />               )<br />               T ;继续循环<br />           )<br />           ((and TmpVar (eq (type TmpVar) 'LIST))<br />               (setq StaPT TmpVar<br />                     Flag T ;循环标志<br />               )<br />               (while Flag<br />                 (if (setq EndPT (getpoint StaPT "\n→请输入下一个点:"))<br />                     (progn<br />                       (setq EndPT (polar StaPT (angle StaPT EndPT) (* Global:SCSVar (distance StaPT EndPT))));放大后的点<br />                       (command "_Line" StaPT EndPT "")<br />                       (setq StaPT EndPT)<br />                     )<br />                     (progn<br />                       (setq Flag Nil);退出循环<br />                       (princ "\n——★★★ 未输入下一点, 程序退出！★★★——")<br />                     )   <br />                 )<br />               ) <br />               nil ;退出循环<br />           )<br />           (T<br />               (princ "\n——★★★ 请输入起点或者关键词！★★★——")<br />               nil ;退出循环<br />           )<br />         )<br />       )  <br />     )<br />     (setvar "cmdecho" Old_CMD)<br />   (vla-endundomark Doc) ;结束编组 <br />   (princ)<br /> )<br />

e2002

可以在需要时，输入计算式：
1. 用 'cal 计算
2. 用AutoCAD自带的计算器
3. 用lisp语句，例如 （* 3400 150）

但无论如何，这种不按实际尺寸绘图，而是沿用手工绘图旧有习惯的方法，完全是自我找虐，是嫌自己还不够累，996还不够吧...
对于各种能高级的解决绘图与（出图）比例两者之间关系问题的功能，如 Annotative Scale， Layout， Viewport 你们这个单位是没一个人会用的，而且也不愿意学。

hubeiwdlue

kucha007 发表于 2023-9-24 00:33
试试这个：
建议还是1：1制图，大不了编块放大或者用布局。要不然比例丢失绘制对不上会很麻烦

谢谢kucha007大神，仰望大神久矣，且屡受恩惠，能得到大神帮助，感激万分。因为周围同事，外院同行绘图比尺大都比较随意，在读图，修改，校核过程中，确有这个需求。再次谢谢大神的帮助。

咏郡

做个沙发，不懂是啥！

bai2000

绘图不是1:1画的么？

hubeiwdlue

bai2000 发表于 2023-9-23 20:49
绘图不是1:1画的么？

画配筋图的时候，平面图可能是1:100，剖面图是1:50或25，大样图可能是1:10。都在一张图里面，就需要用到不同的绘图比例，特别是修改的时候。

hubeiwdlue

咏郡 发表于 2023-9-23 20:28
做个沙发，不懂是啥！

就是画直线的时候，当我输入1我希望它绘制出来是1*n，或者可以直接输入算式，或者是他类似可以1*n的方法。

天命

画图都是1：1的画，出图是按比例出图的，没用过布局吧

woxin168

是不是有点复杂？先按1：1绘制，然后用放大命令按比例缩放不可以吗？这样线条，圆弧啥的都一把搞定多方便。