坡度例行程序
你好，我是这方面的新手，我只是需要一个lisp例程来绘制一个斜率。我已经试过很多了，但效果不好。
谢谢 你能给我们提供更多细节吗？并尽可能具体。非常感谢。 好的，我尝试了很多例程，但它们带来了“这不是一条多段线”的信息，但事实上，我指出的这条线是一条多段线。
http://2.bp.blogspot.com/_GaLPVcZjwQs/S5543I1xGaI/AAAAAAAAIyk/cjCzeSJv0Ik/s320/talude_01.jpg 试试这个
Code:
;|--------------Inclination of line-------------------
q_|_|| _\|| q_|| _\|
يقوم بتحديد ميل الخط من خلال اختيار نقطتين عليه
و من الممكن ان يختار المستخدم
بين ان يرسم خط بين النقطتين او لا
------------------------------------------------------
Author: Hasan M. Asous, 2010
Copyright © 2010 by HasanCAD, All Rights Reserved.
Contact: HasanCAD @ TheSwamp.org,
asos2000 @ CADTutor.net
HasanCAD@gmail.com
------------------------------------------------------
Version: 1 20 Oct 2010
____________________________________________________|;
; q_|_|| _\|| q_|| _\| ;
; Mainroutine Start ;
(defun c:TanLine (/ p1 p2 p3)
; @ HasanCAD
(vl-load-com)
(HSN:DDwnMnuSetSysVar)
(and
(setq doc (cond (doc) ((vla-get-ActiveDocument (vlax-get-Acad-Object)))))
(setq spc (if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc))
(vla-get-modelspace doc)))
)
(if (not TL-sel) (setq TL-sel "Points"))
(initget "select Line or Points")
(setq TL-sel (cond ( (getkword (strcat "\nChooseهل تريد تحديد خط او اختيار نقطتين <" TL-sel ">: ") ) ) ( TL-sel ) ))
(if (equal TL-sel "Points")
(progn
(and
(setq p1 (trans (getpoint "\nFirst Point اختار النقطة الاولى على الخط ")1 0))
(setq p2 (trans (getpoint p1 "\nSecond Point اختار النقطة الثانية على الخط")1 0))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
)
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(IF (< 1000 (ABS (- (cadr p2) (cadr p1))))
(setq h 220)
(if (< 100 (ABS (- (cadr p2) (cadr p1))))
(setq h 22)
(setq h 2.2)))
(if (not TL-Line) (setq TL-Line "Yes"))
(initget "Yes No")
(setq TL-Line (cond ( (getkword (strcat "\nChoose هل تريد رسم خط بين النقطتين <" TL-Line ">: ") ) ) ( TL-Line ) ))
(if (equal TL-Line "Yes")
(progn
(HSN:TL-Text h)
(HSN:TL-Line)
)
(progn
(HSN:TL-Text h)
)
)
)
(progn
(setq TL:SS (entget (car (entsel))))
(if (and
(equal TL-sel "Line")
(equal (cdr (assoc 0 TL:SS)) "LINE")
)
(Progn
(setq p1 (cdr (assoc 10 TL:SS)))
(setq p2 (cdr (assoc 11 TL:SS)))
(setq p3 (trans (getpoint "\nText insertion Point قم بتحديد مكان النص")1 0))
(setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
(HSN:TL-Text)
)
(progn
(princ "\nPLease Seect a line or Points")
)
)
)
)
(HSN:ReDDwnMnuSetSysVar)
(vla-EndUndoMark ActDoc)
)
; q_|_|| _\|| q_|| _\| ;
; Mainroutine End ;
; q_|_|| _\|| q_|| _\| ;
; Subroutine Start ;
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun HSN:DDwnMnuSetSysVar ()
; @ HasanCAD
(setq OldOS (getvar "osmode"))
(setq OldDynmode (getvar "dynmode"))
(setq OldDynprompt (getvar "dynprompt"))
(setvar "osmode" 33)
(setvar "dynmode" 1)
(setvar "dynprompt" 1)
(setvar "cmdecho" 0)
)
(defun HSN:ReDDwnMnuSetSysVar ()
; @ HasanCAD
(setq *error* TERR$)
(setvar "osmode" OldOS)
(setvar "dynmode" OldDynmode)
(setvar "dynprompt" OldDynprompt)
)
(defun HSN:TL-Text (H)
; @ HasanCAD
(entmakex (list
(cons 0 "TEXT")
(cons 10p3)
(cons 40 H)
(cons 1 (strcat (rtos (abs (* tan2 100))2 2) "%"))
))
)
(defun HSN:TL-Line ()
; @ HasanCAD
(entmake (list
(cons 0 "LINE")
(cons 10 p1)
(cons 11 p2)
))
)
; q_|_|| _\|| q_|| _\| ;
; Subroutine End ;
(princ "\nTanLine.lsp ~ Copyright © by HasanCAD")
(princ "\n ...Type TanLine to Invoke... ")
(princ)
您的例程没有返回之前调整过的动态输入。
第一次开始例行程序时，点的选项不起作用。
例程结束时返回错误。。。
为什么不根据直线旋转斜率或选定点旋转插入文字。 此外，以下所有系统变量也没有像以前那样重新设置。
请再次检查您的例行程序。
谢谢
塔瓦特 谢谢塔瓦的回复
你能帮我修复这个错误吗
我能处理的第二条评论
谢谢
不客气。
看看这个，如果你有任何问题，不要犹豫。
享受代码。
塔瓦特 代码很棒，它给了你正确的答案（斜坡阅读）
我希望得到4位小数的答案，并且可以选择插入文本或显示阅读信息。
谢谢
你用过哪种方法，对你有用？（职位编号）
页:
[1]
2