在CAD里用lisp求直线坡度
yianyu
yianyu Lv.2
2008年06月04日 22:34:22
只看楼主

本人用lisp的小程序能在r14下面能查询一条斜线的坡度,可在02以上该命令无法用,请各位高手解答?附:(defun c:pd(/ L0 i jd pdd pcd xq xz );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setvar "cecolor" "ByLayer") (if (= zhb nil) (setzhb));;;纵横比

本人用lisp的小程序能在r14下面能查询一条斜线的坡度,可在02以上该命令无法用,请各位高手解答?

附:
(defun c:pd(/ L0 i jd pdd pcd xq xz );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "cecolor" "ByLayer")
(if (= zhb nil) (setzhb));;;纵横比
(print "ÇëÌôÑ¡Ò»ÌõÖ±Ïß ")
(setq L0 (ssget ’((0 . "line"))))
(pdbz l0)
(pdpcxp)
(huayuan)
)

;;-------------------------------------------------------------------------------------------------
(defun c:pdd(/ L0 i jd pdd pcd xq xz );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq L11 (entsel "ÇëÑ¡ÔñµÚÒ»ÌõÖ±Ïß:"))
(setq L1 (ssname L0 0) L1 (entget L1))
(setq qd (cdr (assoc ’10 L1)) zd (cdr (assoc ’11 L1)))
(setq xq (car qd) yq (cadr qd) xz (car zd) yz (cadr zd))
(if (> xq xz) (setq x xq y yq xq xz yq yz xz x yz y jd))
(setq i (/ (/ (- yz yq) (- xz xq)) ))
(setq p1 (list (/ (+ xq xz) 2) (/ (+ yq yz) 2)))
(setq jd (atan (* i )))
(setq pdd (polar p1 (+ (/ pi 2) jd) 8))
(setq pcd (polar p1 (+ (/ pi 2) jd) -8))
)


;;-------------------------------------------------------------------------------------------------
(defun pdbz(L0 / L1 x y yq yq spl p1 pi cspl ospl )
(setq pi 3.141592654)
(setvar "aunits" 3)
(setq L1 (ssname L0 0) L1 (entget L1))
(setq qd (cdr (assoc ’10 L1)) zd (cdr (assoc ’11 L1)))
(setq xq (car qd) yq (cadr qd) xz (car zd) yz (cadr zd))
(if (> xq xz) (setq x xq y yq xq xz yq yz xz x yz y jd))
(setq i (/ (/ (- yz yq) (- xz xq)) zhb))
(setq p1 (list (/ (+ xq xz) 2) (/ (+ yq yz) 2)))
(setq jd (atan (* i zhb)))
(setq pdd (polar p1 (+ (/ pi 2) jd) 8))
(setq pcd (polar p1 (+ (/ pi 2) jd) -8))
)

(defun pdpcxp(/ cspl spl ospl)
(setq spl (getvar "aunits"))
(setq ospl (getvar "osmode"))
(setq cspl (getvar "cecolor"))

(setvar "cecolor" "5")
(setvar "osmode" 0)

(setq zjd (list (/ (+ (car qd) (car zd)) 2) (/ (+ (cadr qd) (cadr zd)) 2)))
(setq ss (ssget "w" (polar zjd 0.8 -100) (polar zjd 0.8 100)))
(if (/= ss nil) (command "erase" ss ""))

(command "text" "m" pdd 8 jd (strcat (rtos (* i 100) 2 3) "%"))
(command "text" "m" pcd 8 jd (rtos (- xz xq) 2 3))

(setvar "aunits" spl)
(setvar "cecolor" cspl)
(setvar "osmode" ospl)
)



(defun huayuan(/ cspl)
(setq cspl (getvar "cecolor"))
(setvar "cecolor" "5")
(setq ss (ssget "w" (polar zd 0.8 -10) (polar zd 0.8 10)))
(if (= ss nil) ( ) (command "erase" ss ""))
(command "circle" (strcat (rtos xz 2 3) "," (rtos yz 2 3)) 1.25)
(setvar "cecolor" cspl)
)
免费打赏

相关推荐

APP内打开