[讨论]：直线两端缩短

skywaycao

我的一个lisp程序，不知道对大家有用否

功能：对选中的直线两端同时缩短一定的长度


[PHP]
(defun c:lc (/              osm      bli        cmd         CutLength
             en              loop     en1        en1_data EntityType
             p1              p2       x        y         z          MidPoint
             dist     ScaleFactor        width
            )


  (setq osm (getvar "osmode"))
  (setq bli (getvar "blipmode"))
  (setq cmd (getvar "cmdecho"))


  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setq CutLength (getreal "\nSpecify cut length <150>:"))
  (if (null CutLength)
    (setq CutLength 150.0)
  )                                       

;;;in the following, entity loop is cutted
  (setq en (ssget))
  (setq loop 0)
  (repeat (sslength en)
    (setq en1 (ssname en loop))
    (setq en1_data (entget en1))
    (setq EntityType (cdr (assoc 0. en1_data)))
    (if        (= EntityType "LINE")        ;entity type of line is cutted
      (progn
        (setq p1 (cdr (assoc 10 en1_data)))
        (setq p2 (cdr (assoc 11 en1_data)))
        (setq x (/ (+ (car p1) (car p2)) 2.0))
        (setq y (/ (+ (cadr p1) (cadr p2)) 2.0))
        (setq z (/ (+ (caddr p1) (caddr p2)) 2.0))
        (setq MidPoint (list x y z))
        (setq dist (distance p1 p2))
        (setq ScaleFactor (/ (- dist (* CutLength 2.0)) dist))
        (setvar "osmode" 0)
        (command "scale" en1 "" MidPoint ScaleFactor "")
        (setvar "osmode" osm)
      )
    )
    (if        (= EntityType "LWPOLYLINE")  ;entity type of pline is cutted
      (progn
        (setq en1_data (entget en1))
        (setq width (cdr (assoc 43 en1_data)))
        (command "explode" en1 "")
        (setq en1 (entlast))
        (setq en1_data (entget en1))
        (setq p1 (cdr (assoc 10 en1_data)))
        (setq p2 (cdr (assoc 11 en1_data)))
        (setq x (/ (+ (car p1) (car p2)) 2.0))
        (setq y (/ (+ (cadr p1) (cadr p2)) 2.0))
        (setq z (/ (+ (caddr p1) (caddr p2)) 2.0))
        (setq MidPoint (list x y z))
        (setq dist (distance p1 p2))
        (setq ScaleFactor (/ (- dist (* CutLength 2.0)) dist))
        (setvar "osmode" 0)
        (command "scale" en1 "" MidPoint ScaleFactor "")
        (command "pedit" en1 "" "w" width "")
        (setvar "osmode" osm)
      )
    )
    (setq loop (+ loop 1))
  )                                        ;repeat


  (setvar "osmode" osm)
  (setvar "blipmode" bli)
  (setvar "cmdecho" cmd)
  (princ)
)
[/PHP]


需要解决的问题：
1 调用程序后，不是正常退出，出现“ Unknown command "LC"  ”的字样，不知如何解决
2 若选取了多根线段执行命令后，不能用 undo  返回到上一部，主要是lisp中执行了很多小步骤

xyp1964

[php]
;;;加载通用函数
;;;下载：http://www.xdcad.net/forum/showthread.php?s=&threadid=325268
(load "xyp_lib")

;;;直线两端缩短
(defun c:test ()
  (cmdla0)
  (setq #dist (ureal 1 "" "\n两端缩短距离" #dist))
  (setq SS (ssget '((0 . "LINE")))
        i -1)
  (command ".undo" "BE")
  (while (setq s1 (ssname ss (setq i (1+ i))))   
    (setq e (entget s1)
      pt1 (dxf 10 e)
          pt2(dxf 11 e)
          dist(abs(distance pt1 pt2))
          ang(angle pt1 pt2)
          la (dxf 8 e)
    )
    (if (> dist (* #dist 2))
      (progn
        (setq pt3 (polar pt1 ang #dist)
              pt4 (polar pt2 ang (* #dist -1.0))
              )
        (mkla1 la)
        (command"erase" s1 "" "line" pt3 pt4 "")       
        )
      )
    )
  (command ".undo" "E")
  (cmdla1)
)
[/php]

狂刀

use "lengthen" in the lisp will support all type of curve

ljpnb

最初由 狂刀 发布
[B]use "lengthen" in the lisp will support all type of curve [/B]

要除了"spline"线之外

它山之石

WKAI斑主有个更好的程序。带对话框。

狂刀

最初由 ljpnb 发布
[B]

要除了"spline"线之外 [/B]

错！！！
spline不能伸长，但绝对可以缩短！

sdwy19691229

这个程序用处漫大的.
不知道能把射线改为短直线吗?

ljpnb

最初由 狂刀 发布
[B]

错！！！
spline不能伸长，但绝对可以缩短！ [/B]

还是狂刀厉害，确实可以缩短，不过只能是增量值缩短，其它参数不可行。