Guest athabe 发表于 2022-7-6 00:35:41

谢谢你的快速回复，是#8

Tharwat 发表于 2022-7-6 00:38:47

 
这里是四位小数。。
 
 

(defun c:TanLine (/ doc spc *error* TH:UnDo TH:StartUnDo p1 p2 p3 tan2 TL-Line TH:UnDo)
;;; Authour : Hasan Asos    -> Modified by Tharwat
(vl-load-com)
(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)))
   )
(defun *error* (msg)
(and TH:UnDo (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
   (princ (strcat "\n** Error: " msg " **")))
(princ)
)
(setq TH:StartUnDo (vla-StartUndoMark doc))
(initget "Line Points")
(if (eq (setq TL-sel (getkword (strcat "\nChoose : " "< Line >"))) "Points")
   (progn
          (setq p1 (getpoint "\n First Point"))
          (setq p2 (getpoint p1 "\n Second Point "))
          (setq p3 (getpoint "\n Text insertion Point "))
          (setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
          (entmake (list (cons 0 "LINE")(cons 10 (trans p1 1 0))(cons 11 (trans p2 1 0))))
          (entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) (cons 40 (getvar 'textsize))
          (cons 1 (strcat (rtos (abs (* tan2 100)) 2 4) "%"))))
   )
   (progn
   (prompt "\n please Select Line : ")
   (setq TL-Line (ssget '((0 . "LINE"))))
   (setq e (ssname TL-Line 0))
   (setq p1 (cdr (assoc 10 (entget e))))
   (setq p2 (cdr (assoc 11 (entget e))))
   (setq p3 (getpoint "\nText insertion Point "))
   (setq tan2 (/ (- (cadr p2) (cadr p1)) (- (car p2) (car p1))))
   (entmake (list (cons 0 "TEXT")(cons 10 (trans p3 1 0)) (cons 40 (getvar 'textsize))
            (cons 1 (strcat (rtos (abs (* tan2 100)) 2 4) "%"))))
   )
   )
(setq TH:UnDo (vla-EndUndoMark Doc))
(princ "\n Modified by Tharwat")
(princ)
)

Guest athabe 发表于 2022-7-6 00:41:11

非常感谢

Organic 发表于 2022-7-6 00:43:50

事实上，即使使用gps机器控制技术，也没有承包商能够将现场等级定为4D.p.精度。

ketxu 发表于 2022-7-6 00:48:05

@Tharwat：如果直线或两点是相同的x ^^^（可能是90度斜率或100%^^），则不会捕捉到被零除的错误

Tharwat 发表于 2022-7-6 00:49:07

 
你说得对，我刚刚为作者修改了代码，使其只起作用，而不考虑代码本身。当athabe要求我修改十进制数时，我刚刚为他更正了。
 
所以我没有权利玩代码。
 
非常感谢。

prodromosm 发表于 2022-7-6 00:54:19

 
你能把文字样式改成wgsimpl吗。shx公司
 
我试图在你的代码中添加这个命令，但我做错了什么
 
(command "style" "TanLine" "wgsimpl.shx" "" "" "" "" "")

satishrajdev 发表于 2022-7-6 00:56:57

prodromosm尝试以下操作：-
 
 
5

prodromosm 发表于 2022-7-6 00:58:41

谢谢satishrajdev
我用这个
6
工作很好

satishrajdev 发表于 2022-7-6 01:04:24

你的欢迎
页: 1 [2]
查看完整版本: 坡度例行程序