[LISP程序]：（分享＋原创）新手接触lisp 的实用程序

chstart

[php](defun c:ss(/ ent lname);通过选择实体设置当前图层
(setvar "cmdecho" 0)
(setq ent (car (entsel "\nPick an entity on the target layer: ")))
(if ent
  (progn
   (setq ent (entget ent)
         lname (cdr (assoc 8 ent)))
  )
  (progn
     (setq lname (getstring "\nNot to selected, Input layer name: "))
    )
  );if ent
(setvar "clayer" lname)
(princ)
)

(defun c:cc(/ lname ss ent);通过目标物体改变选择实体的图层属性
(setvar "cmdecho" 0)
(prompt "\nSelect the entity(s): ")
(setq ss (ssget))
(if ss
  (progn
   (setq ent (entsel "\nPick an entity on the target layer: "))
   (if ent
    (progn
     (setq ent (entget (car ent)))
     (setq lname (cdr (assoc 8 ent)))
    )
    (progn
     (setq lname (getstring "\nNot to selected, Input layer name: "))
    )
   ) ;if ent
   (command "chprop" ss "" "la" lname "")
  )
)
(princ)
)

(defun c:xc( / os s1 s2 ss1 ss2 pt1 pt2 pt3 pt4 p01 p02 p12 p34);连接线段
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq s1 (entsel "\nPick the First Line:"))
  (if s1 (progn
    (redraw (setq s1 (car s1)) 3)
    (setq s2 (entsel "\nPick the Second Line:"))
  ))
  (if (and s1 s2)
    (progn
      (setq s2 (car s2))
      (redraw s1 3)
      (setq ss1 (entget s1))
      (setq ss2 (entget s2))
      (if (and (= (cdr (assoc 0 ss1)) "LINE" ) (= (cdr (assoc 0 ss2)) "LINE"))
        (progn
          (setq pt1 (cdr (assoc 10 ss1)) pt2 (cdr (assoc 11 ss1))
                pt3 (cdr (assoc 10 ss2)) pt4 (cdr (assoc 11 ss2))
                p01 (list (* 0.5 (+ (car pt1) (car pt2)))
                          (* 0.5 (+ (cadr pt1) (cadr pt2))))
                p02 (list (* 0.5 (+ (car pt3) (car pt4)))
                          (* 0.5 (+ (cadr pt3) (cadr pt4))))
          )
          (if (> (distance pt1 p02) (distance pt2 p02))
            (setq p12 pt1)
            (setq p12 pt2)
          )
          (if (> (distance pt3 p01) (distance pt4 p01))
            (setq p34 pt3)
            (setq p34 pt4)
          )
          (setq ss1 (subst (cons 10 p12) (assoc 10 ss1) ss1)
                ss1 (subst (cons 11 p34) (assoc 11 ss1) ss1))
          (entdel s2)
          (entmod ss1)
        ) ;progn
        (princ "\nPlease select Line!")
      ) ;if
      (redraw s1 4)
    ) ;progn
    (princ "\nPlease select entity!")
  ) ; if s1 s2
  (setvar "osmode" os)
  (princ)
) ; end xc



(defun c:s() (command "stretch" "C"))
(defun c:1() (command "zoom" "1.5x") (prin1))
(defun c:2() (command "zoom" "0.5x") (prin1))
(defun c:zz() (command "zoom" "p"))

(defun c:za() (command "zoom" "a"))
(defun c:zd() (command "zoom" "d"))
(defun c:ze() (command "zoom" "e"))
(defun c:-() (command "zoom" "0.5x"))
(defun c:+() (command "zoom" "2x"))
(defun c:lo() (setvar "cmdecho" 0) (command "layer" "on" "*" ""))
(defun c:lp( / ent lname)
  (setvar "cmdecho" 0)
  (setq ent (entsel "\nPick an entity on the target layer: "))
  (if ent (progn
    (setq ent (entget (car ent)))
    (setq lname (cdr (assoc 8 ent)))
    (setvar "clayer" lname)
  )) ;if ent
  (command "layer" "off" "*" "n" "")
  (princ)
)
(defun c:lk( / ent lname);关闭图层
  (setvar "cmdecho" 0)
  (setq ent (entsel "\nPick an entity on the target layer: "))
  (if ent
    (progn
      (setq ent (entget (car ent)))
      (setq lname (cdr (assoc 8 ent)))
    )
    (setq lname (getstring "\nNot to selected, Input layer name: "))
  ) ;if ent
  (if (= (getvar "clayer") lname)
    (setvar "clayer" "0")
  )
  (command "layer" "off" lname "")
  (princ)
)
;以下程序 源自 Chstart
;改变物体到当前层，并使用层颜色,层的线型
(defun c:rr(/ lname ss )
     (setq ss (ssget))
        (if ss
            (progn
               (setq lname (getvar "clayer"))
               (command "chprop" ss "" "la"    lname
                                        "color" "bylayer"
                                        "ltype" "bylayer" "")
            )
        );if ss
)

;原点打断线段   
(defun c:BB()(setq p1 (getpoint "Select Break Point"))
       (command "break" p1 p1 "" )
)

;隐藏实体，通过regen 可以恢复显示,方便重复线段的选择
(defun c:ee()(setq ss (ssget))
                (setq i 0)
                (while (<= i (sslength ss))
                         (setq abc (ssname SS i))
                          (redraw abc 2)
                          (setq i (+ 1 i))
))[/php]

david96007

开卷有益！
得到不少提示！

丹佛

请问“原点打断线段  ”你测试了吗？好像不能用吧

chstart

可以啊。
我一直都在用这些命令。
break命令可以打断pline，arc，line，spline，不过圆不能直接从原点打断,得另外写程序。

flowerson

我是新手，那些bylayer可以改的对吗？谢谢。

swaywood

对于我来说都是很好的东西，感谢分享！

chstart

最初由 flowerson 发布
[B]我是新手，那些bylayer可以改的对吗？谢谢。 [/B]

“改的对”指得是什么？

lzy9788

chstart ,你是不是在深圳啊？
好像我在深圳一公司的lisp程序，
我现在自制了好多lisp（结构方面的）,
也有用到原来公司的程序.

海豚

最初由 chstart 发布
请问“原点打断线段 ”你测试了吗？好像不能用吧
[B]可以啊。
我一直都在用这些命令。
break命令可以打断pline，arc，line，spline，不过圆不能直接从原点打断,得另外写程序。 [/B]

确实不行，反馈：
BB Select Break Point
Arc cannot be full 360 degreesUnknown command "BB".  Press F1 for help.
nil

lijiao

最初由 海豚 发布
[B][QUOTE]最初由 chstart 发布
请问“原点打断线段 ”你测试了吗？好像不能用吧
[B]可以啊。
我一直都在用这些命令。
break命令可以打断pline，arc，line，spline，不过圆不能直接从原点打断,得另外写程序?.. [/B]

程序是没有大问题，只是缺乏必要的判断，在一些特殊情况下会出错，或者说程序不够健壮。

blueknight

最初由 david96007 发布
[B]开卷有益！
得到不少提示！ [/B]

谢楼住发布