使用autolisp标记

autocrap · 发表于 2022-7-6 09:28:34

我的同事制作了这个lsip例程来测量和标记线，但它不起作用，请帮助。


(defun C:LF()
 (setq en(car (entsel "\n Select Line: ")))
 (setq enlist(entget en)
       pt1 (cdr(assoc 10 enlist))
       pt2 (cdr(assoc 11 enlist))
       ang (angle pt1 pt2)
       dis (distance pt1 pt2)
 )
 (command "Dtext"
   (polar (polar pt1 ang (/ dis 2.0)) (+ ang (/ pi 2.0))(* (getvar"ltscale") 0.0625))
   (* (getvar"ltscale") 0.09375)
   (angtos ang)
   (strcat (rtos (/ dis 12.0) 2 2) "'   " (angtos ang)) 
 )
)

Lt Dan's l · 发表于 2022-7-6 09:32:03

copy


(defun c:lf (/ p1 p2 di ang ins txt)
(setq p1 (getpoint "\nspecify first point: "))
(setq p2 (getpoint p1 "\nspecify second point: "))
(setq di (distance p1 p2))
(setq ang (angle p1 p2))
(setq ins (getpoint "\nspecify text location: "))
(setq txt (strcat (rtos di 2 2) "' " (angtos ang)))
(command "text" ins 2.5 0 txt)
(princ)
)

我刚刚修改了我使用的那个。你需要进一步修改，但我认为这更容易理解发生了什么。

autocrap · 发表于 2022-7-6 09:36:55

谢谢你做得很好

autocrap · 发表于 2022-7-6 09:40:07

有没有可能让它写在建筑而不是十进制

alanjt · 发表于 2022-7-6 09:42:19

值得深思。。。

copy

(defun c:Test (/ ss)
 (if (setq ss (ssget '((0 . "LINE"))))
   ((lambda (i / e l p1 p2 a)
      (while (setq e (ssname ss (setq i (1+ i))))
        (entmake
          (list
            '(0 . "TEXT")
            (cons 10
                  (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
                          (setq p1 (cdr (assoc 10 (setq l (entget e)))))
                          (setq p2 (cdr (assoc 11 l)))
                  )
            )
            (cons 40 (getvar 'textsize))
            (cons 1
                  (strcat (rtos (/ (distance p1 p2) 12.) 4 2)
                          "'   "
                          (angtos (setq a (angle p1 p2)))
                  )
            )
            (cons 50 a)
          )
        )
      )
    )
     -1
   )
 )
 (princ)
)

Lee Mac · 发表于 2022-7-6 09:46:08

很好，艾伦，这是我唯一会做的改变-希望你不介意：

copy


(defun c:Test (/ ss)
 ;; AJ Thompson, angle modified by LeeMac
 (if (setq ss (ssget '((0 . "LINE"))))
   ((lambda (i / e l p p1 p2 a)
      (while (setq e (ssname ss (setq i (1+ i))))
        (entmake
          (list
            '(0 . "TEXT")
            (cons 10
              (setq p ; LM
                  (mapcar (function (lambda (a b) (/ (+ a b) 2.)))
                          (setq p1 (cdr (assoc 10 (setq l (entget e)))))
                          (setq p2 (cdr (assoc 11 l)))
                  )
              )
            )
            (cons 40 (getvar 'textsize))
            (cons 1
                  (strcat (rtos (/ (distance p1 p2) 12.) 4 2)
                          "'   "
                          (angtos (setq a (angle p1 p2)))
                  )
            )
            (cons 50 (LM:MakeReadable a)) ; LM
            (cons 72 1) ; LM
            (cons 73 0) ; LM
            (cons 11 p) ; LM
          )
        )
      )
    )
     -1
   )
 )
 (princ)
)
(defun LM:MakeReadable ( a )
 ;; © Lee Mac 2010
 (cond
   (
     (and (> a (/ pi 2)) (<= a pi))
     (- a pi)
   )
   (
     (and (> a pi) (<= a (/ (* 3 pi) 2)))
     (+ a pi)
   )
   (
     a
   )
 )
)