编起来是什么样子的?是不是很难的?能不能给我一个例子?
能把具体的代码写出来吗?谢谢了(dypsoft前一部分的代码这么没层次感的?是不是LISP就是这样的?我真的连一行LISP也没见过的啊.谢谢了)
我还是喜欢LISP,说过时?呵呵,那你问问天正软体是用什麽开发出来的。其实也挺简单的,举个例子的话,因为我是做建筑设计的,自已写了个Z坐标一次归0的LISP:(vmon) (defun c:zz (/ wholesel count treatcount chcount ent curent segcurent entlist segentlist etflag dfetflag input ) (command "_.undo" "_begin") (setq old_err *error* *error* zz_err ) (princ " ***********Z坐标值归零程序***********作者 燕鹏动力******" ) (setvar "cmdecho" 0) (setq wholesel (ssget '((-4 . "<OR") (0 . "POINT") (0 . "LINE") (0 . "LWPOLYLINE") (0 . "POLYLINE") (0 . "ARC") (0 . "CIRCLE") (0 . "TEXT") (0 . "INSERT") (-4 . "OR>") ) ) ) (if (null wholesel) (progn (princ "/n未选择到有效实体!") (exit) ) ) (setq count 0) (setq treatcount 0) (setq chcount 0) (princ "/n") (while (< count (sslength wholesel)) (setq curent (ssname wholesel count)) (setq entlist (entget curent)) (setq count (1+ count)) (princ "/r已经完成 ") (princ (rtos (/ count (sslength wholesel) 0.01) 2 1)) (princ " %.") (princ) (if (or (/= (cadr (assoc 210 entlist)) 0.0) (/= (caddr (assoc 210 entlist)) 0.0) (/= (cadddr (assoc 210 entlist)) 1.0) ) (progn (if (null dfetflag) (progn (setq dfetflag "N") (setq etflag dfetflag) (initget 0 "Y N") (setq input (getkword (strcat "/n***燕鹏动力友情提示***图中存在伸展方向非常规的实体,若不更改某些Z值不能归零,是否强行更改(Y/N) <" dfetflag ">:" ) ) ) (if input (setq etflag input) ) (setq dfetflag etflag) ) ) (if (= etflag "Y") (progn (setq entlist (subst (cons 210 '(0.0 0.0 1.0)) (assoc 210 entlist) entlist ) ) (entmod entlist) ) ) ) ) (cond ((= "POINT" (cdr (assoc 0 entlist))) (setq oldpt (cdr (assoc 10 entlist))) (if (/= (caddr oldpt) 0.0) (progn (setq treatcount (1+ treatcount)) (setq newpt (list (car oldpt) (cadr oldpt) 0.0)) (setq entlist (subst (cons 10 newpt) (cons 10 oldpt) entlist) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((= "LINE" (cdr (assoc 0 entlist))) (setq oldbgpt (cdr (assoc 10 entlist))) (setq oldendpt (cdr (assoc 11 entlist))) (if (or (/= (caddr oldbgpt) 0.0) (/= (caddr oldendpt) 0.0)) (progn (setq treatcount (1+ treatcount)) (setq newbgpt (list (car oldbgpt) (cadr oldbgpt) 0.0)) (setq newendpt (list (car oldendpt) (cadr oldendpt) 0.0)) (setq entlist (subst (cons 10 newbgpt) (cons 10 oldbgpt) entlist) ) (setq entlist (subst (cons 11 newendpt) (cons 11 oldendpt) entlist ) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((= "LWPOLYLINE" (cdr (assoc 0 entlist))) (if (/= (cdr (assoc 38 entlist)) 0.0) (progn (setq treatcount (1+ treatcount)) (setq entlist (subst (cons 38 0.0) (assoc 38 entlist) entlist ) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((= "POLYLINE" (cdr (assoc 0 entlist))) (setq oldpt (cdr (assoc 10 entlist))) (if (/= (caddr oldpt) 0.0) (progn (setq treatcount (1+ treatcount)) (setq newpt (list (car oldpt) (cadr oldpt) 0.0)) (setq entlist (subst (cons 10 newpt) (cons 10 oldpt) entlist) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((or (= "ARC" (cdr (assoc 0 entlist))) (= "CIRCLE" (cdr (assoc 0 entlist))) ) (setq oldcenpt (cdr (assoc 10 entlist))) (if (/= (caddr oldcenpt) 0.0) (progn (setq treatcount (1+ treatcount)) (setq newcenpt (list (car oldcenpt) (cadr oldcenpt) 0.0)) (setq entlist (subst (cons 10 newcenpt) (cons 10 oldcenpt) entlist ) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((= "TEXT" (cdr (assoc 0 entlist))) (setq oldinspt (cdr (assoc 10 entlist))) (setq oldjustpt (cdr (assoc 11 entlist))) (if (or (/= (caddr oldinspt) 0.0) (/= (caddr oldjustpt) 0.0)) (progn (setq treatcount (1+ treatcount)) (setq newinspt (list (car oldinspt) (cadr oldinspt) 0.0) ) (setq newjustpt (list (car oldjustpt) (cadr oldjustpt) 0.0) ) (setq entlist (subst (cons 10 newinspt) (cons 10 oldinspt) entlist ) ) (setq entlist (subst (cons 11 newjustpt) (cons 11 oldjustpt) entlist ) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ((= "INSERT" (cdr (assoc 0 entlist))) (setq oldinspt (cdr (assoc 10 entlist))) (if (/= (caddr oldinspt) 0.0) (progn (setq treatcount (1+ treatcount)) (setq newinspt (list (car oldinspt) (cadr oldinspt) 0.0) ) (setq entlist (subst (cons 10 newinspt) (cons 10 oldinspt) entlist ) ) (entmod entlist) (setq chcount (1+ chcount)) ) ) ) ) ) (princ (strcat "/n**燕鹏动力友情提示***共选中" (itoa count) "个有效实体, 其中Z坐标值不归零的有" (itoa treatcount) "个实体,成功转换" (itoa chcount) "个实体:||作者 燕鹏动力||http://www.china-abbs.com||" ) ) (princ) (setq etflag nil) (setq dfetflag nil) (command "_.undo" "_end") ) (defun zz_err (s) (princ "/n命令中止!**燕鹏动力友情提示***http://www.china-abbs.com***") (setq etflag nil dfetflag nil ) (redraw) (setq *error* old_err) (princ) ) (princ) 可能这个格式写得看不清,再来一个:数字匹量修改:Change Elevations ;NUM.LSP(defun C:NUM ()(setq ss1 (ssget) len1 (sslength ss1) cnt 0 add (getreal "/nEnter number to add to elevations: ") )(while (< cnt len1) (setq dent (entget (ssname ss1 cnt)) txt (cdr (assoc 1 dent)) len (strlen txt) cnt1 1 ) (while (<= cnt1 len) (if (/= (substr txt cnt1 1) " ") (progn (setq num (atof (substr txt cnt1 len)) numlen (strlen (rtos num 2 5))) (if (/= num 0) (progn (cond ((= (substr txt cnt1 numlen) (rtos num 2 5)) (setq sp 0)) ((= (substr txt cnt1 (- numlen 1)) (rtos num 2 1)) (setq sp 1)) ((= (substr txt cnt1 (- numlen 3)) (rtos num 2 0)) (setq sp 3)) );cond (setq rtxt (substr txt (- (+ cnt1 numlen) sp) len) num (+ add num) numt (rtos num 2 5) ntx (strcat (substr txt 1 (- cnt1 1)) numt rtxt) old (assoc 1 dent) new (cons 1 ntx) dent (subst new old dent) cnt1 (+ 1 len) );setq (entmod dent) );progn )));if,progn,if (setq cnt1 (1+ cnt1)) );end while (setq cnt (1+ cnt)) );while);defun(dypsoft前一部分的代码这么没层次感的?是不是LISP就是这样的?我真的连一行LISP也没见过的啊.谢谢了)那到不是,最主要以前在广州的时候写的,后来直接用记事本文件把源码拷过来,然后就变成格式很乱的了,本人一向挺懒的,所以一直没改过来,就这样一直用了。呵呵。第二段的很清楚明了,应该看得懂。 |
|