■【求助】求程序一个■

CTC

    如上图1，当点1，2点后，命令提示：输入垂直于该线的长度（默认5mm）线长往哪边偏移，最后这些线变成一条多线段。
    如上图2，当点1，2，3，4，5，6点后，命令提示：输入垂直于该线的长度（默认5mm）线长往哪边偏移，最后这些线变成一条多线段。
    如上图3，当点1，2，3，4，5，点后，命令提示：输入垂直于该线的长度（默认5mm）线长往哪边偏移，最后这些线变成一条多线段。
    困于能力问题，特此申请程序一个，希望操作不要太复杂，谢谢大伙了。

langjs

试一试，不知道行不行

(defun c:jcc (/ lst pt pt1 pt2 pt4 pt5 r1 r2 r3 s snap)
  (setvar "cmdecho" 0)
  (setq lst '())
  (while (setq pt (getpoint "\n指定端点:"))
    (setq lst (cons pt lst))
  )
  (if (null dbak)
    (setq dbak 5.0)
  )
  (setq pt5 (car lst))
  (setq pt4 (cadr lst))
  (initget "S ")
  (while (progn
           (if (= (setq pt (getpoint pt5 (strcat "\n指定垂直线方向[垂直线长" (rtos dbak 2 2) ",重设(S)]:")))
                  "S"
               )
             (if (setq s (getreal (strcat "\n垂直线长:<" (rtos dbak 2 2) ">")))
               (setq dbak s)
             )
           )
           (not (= (type pt) 'list))
         )
  )
  (setq r1 (angle pt4 pt5))
  (setq r2 (angle pt5 pt))
  (if (or
        (and
          (< (- r2 r1) pi)
          (> (- r2 r1) 0)
        )
        (< (- r2 r1) (- pi))
      )
    (setq lst (cons (polar pt5 (+ (* 0.5 pi) r1) dbak) lst))
    (setq lst (cons (polar pt5 (+ (* 1.5 pi) r1) dbak) lst))
  )
  (setq lst (reverse lst))
  (setq pt1 (car lst))
  (setq pt2 (cadr lst))
  (setq r3 (angle pt1 pt2))
  (if (or
        (and
          (< (- r2 r1) pi)
          (> (- r2 r1) 0)
        )
        (< (- r2 r1) (- pi))
      )
    (setq lst (cons (polar pt1 (+ (* 0.5 pi) r3) dbak) lst))
    (setq lst (cons (polar pt1 (+ (* 1.5 pi) r3) dbak) lst))
  )
  (command ".undo" "be")
  (setq snap (getvar "osmode"))
  (setvar "osmode" 0)
  (command "PLINE")
  (foreach pt lst
    (command pt)
  )
  (command "")
  (setvar "osmode" snap)
  (command ".undo" "e")
  (princ)
)

CTC

langjs 发表于 2012-2-5 00:37
试一试，不知道行不行

(defun c:jcc (/ lst pt pt1 pt2 pt4 pt5 r1 r2 r3 s snap)

langjs 你好，谢谢你的程序，用了还行，不知在点端点画直线过程中，端点与端点的线可以像LINE命令那样显示出来呢？我04的在画过程中没有显示出来。

cabinsummer

机械行业的剖视符号程序

langjs

原来是剖视符号啊，可是不大像啊，剖视符号要断开的。晕死，作为机械设计人员居然看不出来感到汗颜！我还为是钣金屏柜折弯一类的程序呢！

langjs

试试这个行不行
(defun c:cc ( / ent lst pt pt1 pt2 pt4 pt5 r1 r2 r3 s snap)
  (setvar "cmdecho" 0)
  (setq lst '())
  (princ "\n指定起点:")
  (command "pline")
  (while (= 1 (getvar "cmdactive"))
    (command pause)
    (setq pt (getvar "lastpoint"))
    (princ "\n指定下一点")
    (setq lst (cons pt lst))
  )
  (setq ent (entlast))
  (if (null dbak)
    (setq dbak 5.0)
  )
  (setq lst (cdr lst))
  (if (>= (length lst) 2)
    (progn
      (setq pt5 (car lst))
      (setq pt4 (cadr lst))
      (initget "S ")
      (while (progn
               (if (= (setq pt (getpoint pt5 (strcat "\n指定垂直线方向[垂直线长" (rtos dbak 2 2) ",重设(S)]:")))
                      "S"
                   )
                 (if (setq s (getreal (strcat "\n垂直线长:<" (rtos dbak 2 2) ">")))
                   (setq dbak s)
                 )
               )
               (not (= (type pt) 'list))
             )
      )
      (entdel ent)
      (setq r1 (angle pt4 pt5))
      (setq r2 (angle pt5 pt))
      (if (or
            (and
              (< (- r2 r1) pi)
              (> (- r2 r1) 0)
            )
            (< (- r2 r1) (- pi))
          )
        (setq lst (cons (polar pt5 (+ (* 0.5 pi) r1) dbak) lst))
        (setq lst (cons (polar pt5 (+ (* 1.5 pi) r1) dbak) lst))
      )
      (setq lst (reverse lst))
      (setq pt1 (car lst))
      (setq pt2 (cadr lst))
      (setq r3 (angle pt1 pt2))
      (if (or
            (and
              (< (- r2 r1) pi)
              (> (- r2 r1) 0)
            )
            (< (- r2 r1) (- pi))
          )
        (setq lst (cons (polar pt1 (+ (* 0.5 pi) r3) dbak) lst))
        (setq lst (cons (polar pt1 (+ (* 1.5 pi) r3) dbak) lst))
      )
      (command ".undo" "be")
      (setq snap (getvar "osmode"))
      (setvar "osmode" 0)
      (command "PLINE")
      (foreach pt lst
        (command pt)
      )
      (command "")
      (setvar "osmode" snap)
      (command ".undo" "e")
    )
  )
  (princ)
)

CTC

langjs 发表于 2012-2-5 09:36
试试这个行不行
(defun c:cc ( / ent lst pt pt1 pt2 pt4 pt5 r1 r2 r3 s snap)
  (setvar "cmdecho" 0)
...

谢谢langjs的程序，可以了。。。

pslstar