社区 › Auto Lisp › 我需要一个LISP或工具Pac

afrazawan 发表于 2022-7-6 09:32:52

我需要一个LISP或工具Pac

请任何人都可以帮助我，我需要一个好的LISP或Toolpac来放置cordinate点或任何级别，请紧急假设我点击的任何点，我得到N:E：点，领导者在中心

Tharwat 发表于 2022-7-6 09:40:55

看看这个，伙计。
 
(defun c:TesT (/ *error* hgt cmd i icar icadr icaddr pt1 pt2 e)
; Tharwat 01. 05. 201
(defun *error* (msg)
(and cmd (setvar 'cmdecho cmd))
(redraw)
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
   (princ (strcat "\nError: " msg))
)
)
(setq Sty (tblnext "STYLE" (null Sty)))
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
       (while
         (setq i (getpoint "\n Specify Corrdinates Point :")
            icar (car i)
            icadr (cadr i)
                icaddr (caddr i))
            (setq pt1 (getpoint "\n Second point of QLeader :" i ))
            (grdraw i pt1 3 1)
            (setq pt2 (getpoint "\n Last point of QLeader :" pt1 ))

(entmakex (list (cons 0 "LEADER") (cons 100 "AcDbEntity") (cons 100 "AcDbLeader")
         (cons 10 i)(cons 10 PT1)(cons 10 PT2)(cons 71 1)(cons 72 0)(cons 73 3)))

(entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (trans pt2 1 0))
         (cons 40 (cdr (assoc (if (zerop (cdr (assoc 40 Sty))) 42 40) Sty )))
         (cons 1 (strcat "N" ":" (rtos icar 2 0) "\n" "E" ":" (rtos icadr 2 0)))))

   (redraw)

      )
(setvar 'cmdecho cmd)
(princ)
)

 
塔瓦特

afrazawan 发表于 2022-7-6 09:42:27

 
 
 
兄弟，不是这个，任何一点Lisp程序，请我拿不到谢谢

Tharwat 发表于 2022-7-6 09:47:50

 
很难用一点细节来描述你在寻找什么吗？

Organic 发表于 2022-7-6 09:51:38

 
我觉得你的Lisp程序很好。似乎做了OP想要做的一切，因为我也解释了他的帖子。

afrazawan 发表于 2022-7-6 09:54:30

看，我想得到cordinate E：和N：所以请这是样品

Tharwat 发表于 2022-7-6 10:00:21

 
谢谢丁克。
 
我想OP很难描述他的目标。

Organic 发表于 2022-7-6 10:02:16

 
塔尔瓦特的Lisp程序确实能给你提供东向和北向。
 
你是说你想让它先标记为Easting，然后标记为Northing而不是N，E？

Tharwat 发表于 2022-7-6 10:08:22

这是先东后北。
 
(defun c:TesT (/ *error* hgt cmd i icar icadr pt1 pt2 e)
                                       ; Tharwat 01. 05. 201
(defun *error* (msg)
   (and cmd (setvar 'cmdecho cmd))
   (redraw)
   (if (and msg
            (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))
       )
   (princ (strcat "\nError: " msg))
   )
)
(setq Sty (tblnext "STYLE" (null Sty)))
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(while
   (setq i   (getpoint "\n Specify Corrdinates Point :")
         icar(car i)
         icadr (cadr i)
   )
    (setq pt1 (getpoint "\n Second point of QLeader :" i))
    (grdraw i pt1 3 1)
    (setq pt2 (getpoint "\n Last point of QLeader :" pt1))

    (entmakex (list (cons 0 "LEADER")
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbLeader")
                  (cons 10 i)
                  (cons 10 PT1)
                  (cons 10 PT2)
                  (cons 71 1)
                  (cons 72 0)
                  (cons 73 3)
            )
    )

    (entmakex
      (list (cons 0 "MTEXT")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans pt2 1 0))
            (cons 40
                  (cdr (assoc (if (zerop (cdr (assoc 40 Sty)))
                              42
                              40
                              )
                              Sty
                     )
                  )
            )
            (cons 1
                  (strcat "E"
                        ":"
                        (rtos icar 2 0)
                        "\n"
                        "N"
                        ":"
                        (rtos icadr 2 0)
                  )
            )
      )
    )

    (redraw)

)
(setvar 'cmdecho cmd)
(princ)
)

alanjt 发表于 2022-7-6 10:10:14

做一个方块。。
 
 
 
顺便说一句，Tharwat，在将坐标转换为字符串之前，应该考虑转换坐标。

查看完整版本: 我需要一个LISP或工具Pac