yang686526

求助一个新建坐标lisp，谢谢！
www.dimcax.com
求助一个新建坐标lisp，谢谢！
(defun c:xs()
(command "ucs" "n")
)
我现在想输入命令xs后就自动让我选外观交点app,因为这样坐标0点避免选错，我直接打开外观交点不能使用，非要在执行命令时输入app才能选取，请各位帮帮忙，谢谢！

(defun *error*(st)
(if (and (/= st "function cancelled")
(/= st "quit / exit abort")
)
(princ (strcat "错误: " st))
)
(setq *error* old_err)
(princ)
)
(defun sort (l / lt ltem vmax vmin l1 l2 l3
lt0 ltem0 ltem1 l30 vmax0 vmin0 l10 l20)
(setq ltem (mapcar 'car l) ;ltem : 取出l的第一项形成的表
vmin (1- (apply 'min ltem)) ;vmin : 是一个比ltem中最小的数还小的数
)
(while (< vmin (setq vmax (apply 'max ltem))) ;从ltem中取出最大值
(setq l1 l l3 nil ltem (subst vmin vmax ltem)) ;去掉最大值
(while (setq l2 (assoc vmax l1)) ;取出最大值所对应的项
(setq l1 (cdr (member l2 l1))) ;处理相同的值
(setq l3 (cons l2 l3))
)
(progn
(setq ltem0 (mapcar 'cadr l3)
ltem1 (mapcar 'car l3)
l30 (mapcar 'cdr l3)
vmin0 (1- (apply 'min ltem0))
)
(while (< vmin0 (setq vmax0 (apply 'max ltem0)))
(setq l10 l30 ltem0 (subst vmin0 vmax0 ltem0))
(while (setq l20 (assoc vmax0 l10))
(setq l10 (cdr (member l20 l10)))
(setq lt0 (cons l20 lt0))
)
)
(setq l3 (mapcar 'cons ltem1 lt0))
(setq l3 (reverse l3))
)
(setq lt (append l3 lt))
)
)
(defun dxf (code en)
(cdr (assoc code en))
)
(defun pross (bp sp / tem ss n el ip lpt en pt en1 en2 en3 w dis ang
di el1 el2 el3 pt1 pt2 pt3 pt4 pt5 pt6)
(if (> (car bp) (car sp))
(setq tem bp bp sp sp tem)
)
(setq ss nil)
(if (setq ss (ssget "c" bp sp))
(progn
(setq n 0)
(repeat (sslength ss)
(setq el (entget (setq en (ssname ss n))))
(if (and (= (dxf 0 el) "line")
(or (= (dxf 8 el) "wall") (= (dxf 8 el) "gwall"))
(setq ip (inters bp sp (dxf 10 el) (dxf 11 el)))
) ; ip 交点
(progn
(setq lpt (cons ip lpt))
)
)
(setq n (1+ n))
) ; repeat 找出所有的交点并形成表lpt
(if (/= nil lpt) (setq lpt (sort lpt)))
)
)
(if (> (length lpt) 2) (princ "\n警告:墙线有重线或选中了三条以上的墙线 !"))
(if (< (length lpt) 2) (princ "\n警告:选中的墙线少于两条 !"))
(if (/= nil lpt)
(progn
(setq pt (car lpt))
(setq ss (ssget pt))
(setq en1 (ssname ss 0))
(setq pt (cadr lpt))
(setq ss nil)
(setq ss (ssget pt))
(setq en2 (ssname ss 0))
)
)
(setq en3 (car (entsel "\n选择左或下参考线(轴线和墙线均可)")))
(setq el1 (entget en1))
(setq el2 (entget en2))
(setq el3 (entget en3))
(setq ip nil)
(setq ip (inters (dxf 10 el1) (dxf 11 el1) (dxf 10 el3) (dxf 11 el3) nil))
(initget 6)
(if (= nil dd) (setq dd 1050.0))
(setq dis (getdist ip (strcat "\n距参考点的距离 <" (rtos dd 2 0) ">:")))
(if (= nil dis) (setq dis dd))
(setq dd dis)
(initget 6)
(if (= nil ww) (setq ww 900.0))
(setq w (getreal (strcat "\n窗宽 <" (rtos ww 2 0) ">:")))
(if (= nil w) (setq w ww))
(setq ww w)
(setq ang (angle (dxf 10 el1) (dxf 11 el1))) (setq aaa ang)
(if (>= ang 3.14159265) (setq ang (- ang pi)))
(if (= ang (* pi 2)) (setq ang 0))
(setq di (distance (dxf 10 el1) (inters (dxf 10 el1) (polar (dxf 10 el1) (+ ang (* pi 0.5)) 100) (dxf 10 el2) (dxf 11 el2) nil)))
(setq pt1 (polar ip ang dis))
(setq pt2 (polar pt1 ang w))
(command "break" en1 pt1 pt2)
(setq pt3 (polar pt1 (+ ang (* pi 1.5)) di))
(setq pt4 (polar pt3 ang w))
(command "break" en2 pt3 pt4)
(if (= (dxf 8 el) "gwall")
(command "layer" "s" "gwall" "")
(command "layer" "s" "wall" "")
)
(command "line" pt1 pt3 "")

感谢楼主的回复，你这个程式我执行不了，我只是想知道在程式中怎样加入透明命令

(command "ucs" (list 100 100) (list 50 50) "")
该代码新建一个坐标系，原点在原坐标系的（100，100）处
方向与原坐标系夹角为45°
progress every day!!!