求mline多线画双线，鼠标指定方向

sj800918

求多线画双线，最后一步鼠标指定方向
自己是小白，用老师们的源码堆叠了一下。请大师指点一下，谢谢！

(defun c:tt()
(command "_mline" )
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
(setq c (entlast))
(command "explode" c )
  (setvar "CMDECHO" 0)
   (if (setq ss (ssget "x"'((0 . "LINE"))))
   (command ".PEDIT" "M" ss "" "J" "0.5" "")
)
(setvar "CMDECHO" 1)
  (princ)
)

llsheng_73

sj800918 发表于 2015-12-11 16:01
或者是用这个调整一下最后指定线的方向也行，虽说麻烦了点，还要预先设一下多线的封口
(defun c:q()
(c ...

1. (defun c:tt(/ e a b c)
   
2.   (while(<(setq d(if(setq a(getreal(strcat"\n双线宽度["(if d(rtos d)"10")"]")))a(if d d 10)))0))
   
3.   (command"pline")
   
4.   (while(>(getvar "CMDACTIVE")0)(command PAUSE))
   
5.   (setq e(entlast))
   
6.   (command"offset"d e pause nil)
   
7.   (setq a(entlast)c(entget a)e(reverse(entget e))b(assoc 90 e))
   
8.   (entmod(append(reverse(cdr(member b e)))
   
9.   (list(cons 90(+(cdr b)(cdr(assoc 90 c))))'(70 . 1))
   
10.   (vl-remove-if'(lambda(x)(/=(car x)10))(append e c))))
    
11.   (entdel a)
    
12.   )

(defun c:tt(/ e a b c)<br />   (while(<(setq d(if(setq a(getreal(strcat"\n双线宽度["(if d(rtos d)"10")"]")))a(if d d 10)))0))<br />   (command"pline")<br />   (while(>(getvar "CMDACTIVE")0)(command PAUSE))<br />   (setq e(entlast))<br />   (command"offset"d e pause nil)<br />   (setq a(entlast)c(entget a)e(reverse(entget e))b(assoc 90 e))<br />   (entmod(append(reverse(cdr(member b e)))<br />   (list(cons 90(+(cdr b)(cdr(assoc 90 c))))'(70 . 1))<br />   (vl-remove-if'(lambda(x)(/=(car x)10))(append e c))))<br />   (entdel a)<br />   )

sj800918

晕啊，之前那个代码加了个“X”基本实现了自已选直线
但还是期待大神能给出更好的解决方案，比如画多线画完后，手动选择(鼠标)多线的方向。之后打散，再组成多段线，谢谢！

llsheng_73

1. (defun c:tt(/ e a p pt)
   
2.   (command "_mline" )
   
3.   (while(>(getvar "CMDACTIVE")0)(command PAUSE))
   
4.   (setq e(entlast)
   
5.         a(entget e))
   
6.    (entdel e)
   
7.   (repeat(car(assoc 72 a))
   
8.     (setq p(assoc 11 a)a(cdr(member p a))
   
9.           pt(cons(list(cdr p)(cdr(nth 1 a))(abs(cdr(nth 7 a))))pt)))
   
10.   (entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline"))
    
11.                   (cons(cons 90(length pt))(mapcar'(lambda(x)(cons 10(car x)))pt))))
    
12.   (entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline"))
    
13.                   (cons(cons 90(length pt))(mapcar'(lambda(x)(cons 10(polar(car x)(angle(cadr x)'(0 0))(last x))))pt))))
    
14.   )

(defun c:tt(/ e a p pt)<br />   (command "_mline" )<br />   (while(>(getvar "CMDACTIVE")0)(command PAUSE))<br />   (setq e(entlast)<br />         a(entget e))<br />    (entdel e)<br />   (repeat(car(assoc 72 a))<br />     (setq p(assoc 11 a)a(cdr(member p a))<br />           pt(cons(list(cdr p)(cdr(nth 1 a))(abs(cdr(nth 7 a))))pt)))<br />   (entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline"))<br />                   (cons(cons 90(length pt))(mapcar'(lambda(x)(cons 10(car x)))pt))))<br />   (entmakex(append'((0 . "lwpolyline")(100 . "AcDbEntity")(100 . "AcDbPolyline"))<br />                   (cons(cons 90(length pt))(mapcar'(lambda(x)(cons 10(polar(car x)(angle(cadr x)'(0 0))(last x))))pt))))<br />   )

好象理解错楼主的意思了,也许下边一个才是楼主的意思，如果还是不对，实在猜不出来了

1. (defun c:tt(/ d e a)
   
2.   (vl-load-com)
   
3.   (command"pline")
   
4.   (while(<(setq d(if(setq d(getreal"\n双线宽度[10]"))d 10))0))
   
5.   (initget "C L  ")
   
6.   (setq a(if(setq a(getkword"\n绘制位置:中间(C)一边(L)[L]"))a"L"))
   
7.   (while(>(getvar "CMDACTIVE")0)(command PAUSE))
   
8.   (setq e(entlast)d(if(="C"a)(/ d 2)d))
   
9.   (if(="C"a)(progn(vla-offset(vlax-ename->vla-object e)d)(vla-offset(vlax-ename->vla-object e)(- d))(entdel e))
   
10.   (command"offset"d e pause nil))
    
11.   )

(defun c:tt(/ d e a)<br />   (vl-load-com)<br />   (command"pline")<br />   (while(<(setq d(if(setq d(getreal"\n双线宽度[10]"))d 10))0))<br />   (initget "C L  ")<br />   (setq a(if(setq a(getkword"\n绘制位置:中间(C)一边(L)[L]"))a"L"))<br />   (while(>(getvar "CMDACTIVE")0)(command PAUSE))<br />   (setq e(entlast)d(if(="C"a)(/ d 2)d))<br />   (if(="C"a)(progn(vla-offset(vlax-ename->vla-object e)d)(vla-offset(vlax-ename->vla-object e)(- d))(entdel e))<br />   (command"offset"d e pause nil))<br />   )

sj800918

llsheng_73 发表于 2015-12-11 15:02
好象理解错楼主的意思了,也许下边一个才是楼主的意思，如果还是不对，实在猜不出来了

第一个运行提示
命令: ; 错误: 参数类型错误: consp nil

第二个大概是这个意思，但能否帮我调整一下
1、双线宽度能否记忆上一次输入的尺寸,直接调用，只有在需要的时候像多线一样输入个S，调整线间距。
2、双线两头需要用直线封口
3、不需要选择线在中间还是边上，直接在一边就可以了

谢谢大神！

sj800918

llsheng_73 发表于 2015-12-11 15:02
好象理解错楼主的意思了,也许下边一个才是楼主的意思，如果还是不对，实在猜不出来了

或者是用这个调整一下最后指定线的方向也行，虽说麻烦了点，还要预先设一下多线的封口
(defun c:q()
(command "_mline")
(while (> (getvar "CMDACTIVE") 0) (command PAUSE))
(setq c (entlast))
(command "explode" c )
  (setvar "CMDECHO" 0)
   (if (setq ss (ssget "x"'((0 . "LINE"))))
   (command ".PEDIT" "M" ss "" "J" "0.5" "")
)
(setvar "CMDECHO" 1)
  (princ)
)

sj800918

llsheng_73 发表于 2015-12-10 16:14

您给的代码完美解决了我的问题，但能否再麻烦给我优化一下？
现在运行的顺序是，输入TT，回车，改线的宽度，回车，再指定第一点。。。
能否实现，输入TT，回车，提示：“指定第一点或输入S改变线宽【10（现在的线宽）】”。如不输入S，就直接开始画线。需要改变线宽时再多输一步S，谢谢！

sj800918

哪位大神路过给调一下呗，谢谢！

999999

顶一下，谢谢分享

czb203

感谢楼主分享下载试试!