开发工具:
文件大小: 611kb
下载次数: 0
上传时间: 2018-06-04
详细说明： 超级详细 (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 lt em (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 lpt0 en pt pt0 en pt1 ang ang1) ; (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 (ssname ss n))) (if (and (= (dxf 0 el) "LINE") (or (= (dxf 8 el) "WALL") (= (dxf 8 el) "AXIS")) (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))) ) ) (setq pt0 '(0 0 0)) ;以下9行去掉相同的数据 (foreach pt lpt (if (< (distance pt0 pt) 0.000001) (princ "\n警告:墙线有重线") (setq lpt0 (cons pt lpt0)) ) (setq pt0 pt) ) (setq lpt (sort lpt0)) (setq el (entget (setq en (car (entsel "\n点一下第二排尺寸线: "))))) (setq ang (angle bp sp)) ; (if (= ang (* pi 2)) (setq ang 0))(princ ang) ;(if (>= ang pi) (setq ang (- ang pi))) (setq di (distance bp (inters bp (polar bp (+ ang (* pi 0.5)) 100) (dxf 10 el) (dxf 11 el) nil))) (setq di (- di 700)) (setq pt1 (polar (car lpt) (+ ang (* pi 0.5)) di)) (command "line" (polar pt1 (+ ang (* pi 1.5)) 700) (polar pt1 (+ ang (* pi 0.5)) 300) "") (command "pline" (polar pt1 (+ ang (* pi 1.25)) 70.7) "w" "50" "50" (polar pt1 (+ ang (* pi 0.25)) 70.7) "") (foreach pt (cdr lpt) (setq pt (polar pt (+ ang (* pi 0.5)) di)) (command "line" (polar pt (+ ang (* pi 1.5)) 700) (polar pt (+ ang (* pi 0.5)) 300) "") (command "pline" (polar pt (+ ang (* pi 1.25)) 70.7) "w" "50" "50" (polar pt (+ ang (* pi 0.25)) 70.7) "") (command "line" pt1 pt "") (setq txt (rtos (setq dis (distance pt1 pt)) 2 0)) (setq len (sqrt (+ (* 115 115) (* (/ dis 2.0) (/ dis 2.0))))) (setq ang1 (atan (/ 115 (/ dis 2.0)))) (command "text" "c" (polar pt1 (+ ang ang1) len) "300" (* (/ ang pi) 180) txt) (setq pt1 pt) ) ) ;;;============================================== ;;; main programm ;;;============================================== (defun C:3dimzs(/ bp sp) (setq old_err *error*) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) (command "layer" "m" "dim" "c" "g" "dim" "") (setq bp (getpoint "\n第一点(一般为外墙线上两点): ")) (if (= nil bp) (quit)) (setq sp (getpoint bp "\n第二点: ")) (if (= nil sp) (quit)) (pross bp sp) (princ) ) ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
