返回cad对象的祖玛 lisp程序
返回cad对象的祖玛 lisp程序
返回cad对象的祖玛 lisp程序
返回cad对象的祖玛 lisp程序
2023-04-29 03:47:51
440B
1
Visual LISP程序设计及其应用教程 周明 源代码
《Visual LISP程序设计及其应用教程》共分14个章节，全面讲述了Visual LISP的基础知识，并介绍了作者的编程经验，具体内容包括Visual LISP的编程环境、AutoLISP的数据与程序、AutoLISP程序设计实例、Visual LISP函数补充、图形数据库与非图形数据库等。该书可供各大专院校作为教材使用，也可供从事相关工作的人员作为参考用书使用。
2022-09-05 09:18:38
384KB
1
超级详细
(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 ( (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 (= 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)
)
2022-03-22 17:31:01
611KB
1
CAD中能提高效率的lisp小程序：
1、计算所有线段总长度
2、标注所有线段
3、连续打断程序
4、将CAD文字导入Excel表格
2022-01-11 15:59:46
14KB
1