komfort 发表于 2022-7-5 17:19:07

干得好。。。你必须加载这两个lisp的工作,它的作品完美的为我。
 
;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;alan thompson (6.4.07)
(DEFUN C:PID()
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond   ((= answer "L")      (setq kopy 1))
       ((= answer "leader")    (setq kopy 1))
       ((= answer "")      (setq kopy 1))
       ((= answer "N")      (setq kopy 2))
       ((= answer "No")    (setq kopy 2))
       (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
(setq pt (getpoint "\nSelect point to identify: "))
(setq pt2 (getpoint pt "\nSelect point for text placement: "))
(setq ptascii-x (car pt))
(setq ptascii-x (rtos ptascii-x))
(setq ptascii-y (cadr pt))
(setq ptascii-y (rtos ptascii-y))
(setq ptascii-z (caddr pt))
(setq ptascii-z (rtos ptascii-z))
(setq textstr1 (strcat"NORTHING: "ptascii-y ))
(setq textstr2 (strcat "EASTING: " ptascii-x ))
(setq textsize-flag (getvar "TEXTSIZE"))
(if (/= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
)
(if (= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
)
)
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
(setq pt (getpoint "\nSelect point to identify: "))
(setq ptascii-x (car pt))
(setq ptascii-x (rtos ptascii-x))
(setq ptascii-y (cadr pt))
(setq ptascii-y (rtos ptascii-y))
(setq ptascii-z (caddr pt))
(setq ptascii-z (rtos ptascii-z))
(setq textstr1 (strcat"NORTHING: "ptascii-y ))
(setq textstr2 (strcat "EASTING: " ptascii-x ))
(setq textsize-flag (getvar "TEXTSIZE"))
(if (/= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
)
(if (= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
)
)

) ; End of Progn
) ; End of If
(princ))
 
 
 

(defun c:NEL
      (/ ANNOTATION LEADERPOINT NEWMLEADER POINT POINTS)
(vl-load-com)
(setq Point   (getpoint "\nSpecify point: ")
Point   (list (car Point) (cadr Point) 0.0)
LeaderPoint (getpoint Point "\nSpecify Leader End Point: ")
LeaderPoint (list (car LeaderPoint) (cadr LeaderPoint) 0.0)
Points   (vlax-make-safearray vlax-vbDouble '(0 . 5))
Points   (vlax-safearray-fill Points (append Point LeaderPoint))
Annotation
   (strcat "N "
      (rtos (cadr Point))
      "\\PE "
      (rtos (car Point))
   )
Annotation
   (vlax-invoke-method
       (findSpace)
       'AddMtext
       (vlax-safearray-fill
(vlax-make-safearray vlax-vbDouble '(0 . 2))
LeaderPoint
       )
       0
       Annotation
   )
)
(vlax-put-property
   Annotation
   'Height
   (* (getvar "dimscale") (getvar "dimtxt"))
)
(vlax-invoke-method
   (FindSpace)
   'AddLeader
   Points
   Annotation
   acLineWithArrow
)
)

Least 发表于 2022-7-5 17:25:10

我在工作中使用的程序的一部分中使用了这个,不过你必须稍微修改一下
 

(defun
       FINDSPACE
                (/ *DOC*)
   (vl-load-com)
   (setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
   (setq SPACE (if (= 1 (vla-get-activespace *DOC*))
               (vla-get-modelspace *DOC*) ;we're in modelspace
               (if (= (vla-get-mspace *DOC*) :vlax-true)
                   (vla-get-modelspace *DOC*) ;we're in modelspace
         ;thru paperspace VPort
                   (vla-get-paperspace *DOC*) ;we're in paperspace
               ) ;_ end of if
               ) ;_ end of if
   ) ;_ end of setq
) ;_ end of defun

 
条例字符串只是我设置网格字母的一种懒惰方式
 
我必须感谢戴哈夫,因为他把这一点变成了一根弦

ASMI 发表于 2022-7-5 17:26:06

 
 
 
哇,这是我第一次看到我的作品被张贴在某个地方,而我没有张贴。自然生长的无论如何,我想我应该更新一下。它仍然使用cond而不是关键字(只是草率)。但是,现在它将使用qleader而不是leader,并将qleader设置重置为之前的设置。
顺便说一句,你是在哪里找到这个帖子的(只是好奇)?
 
以下是更新后的代码:享受
 
   

(defun C:Ref()


(Setq Ref_point nil)

   (while (= Ref_point nil)
       (Setq Ref_point (getpoint "\nSelect point of reference\n"))
      
         (cond
               ( (= Ref_point nil)
                   (alert "No point selected")
               )
         
         )
         )




    (setq precis 0)

    (setq Xval (car Ref_point) Yval (cadr Ref_point))

         (setq Xtxt (rtos Xval 2 precis))

          (setq Xco1(substr Xtxt 1 3))
      (setq Xco2(substr Xtxt 4 6))
         (Setq X_Final(strcat "X: "Xco1","Xco2))

       (setq Ytxt (rtos Yval 2 precis))
   
          (setq Yco1(substr Ytxt 1 3))
          (setq Yco2(substr Ytxt 4 6))
             (Setq Y_Final(strcat "Y: "Yco1","Yco2))



   ;Ordinance detail;

         (Setq Ord1 (substr Xco1 1 1))
         (Setq Ord2 (substr Yco1 1 1))
   (Setq Ordref (strcat Ord1 Ord2))

         (Setq Ordinance_convert (atoi Ordref))


(Setq Ordinance "_-_-_-_-_-_-_-WRMGB_-_-_XSNHC_-_-_YTOJD_-_-_ZU-K")


   (Setq Ordinance_letter (substr Ordinance Ordinance_convert 1))
   
       (Setq Ord_numX (Substr Xtxt 2 2))
       (Setq Ord_numY (Substr Ytxt 2 2))

(Setq Ordinance_final( strcat "(N" Ordinance_letter ": " Ord_numX Ord_numY ")"))


   ;Printing Text;




(command "text""s""Standard" Ref_point"" X_final)
         (Setq X_print (entlast))


(command "text" ""Y_final)
         (Setq Y_print (entlast))

(command "text" ""Ordinance_final)
         (Setq Ord_print (entlast))

)


smorales02 发表于 2022-7-5 17:31:59

 
有没有办法设置文字样式?每次我使用它时,它都会放置标准的文本样式,即使它不是我的默认样式。

ollie 发表于 2022-7-5 17:34:36

 
哦,天哪,那代码太尴尬了!
 
对于引线/Q引线,文本样式在活动标注样式中设置。但是,您可以通过设置DIMTXSTY系统变量暂时覆盖它。完成后一定要重置。
尽管如此,如果你参加2016年的比赛,我希望你能使用MLeader。

alanjt 发表于 2022-7-5 17:36:43

RubberDinero 发表于 2022-7-5 17:39:55

 
Is there a way to set the Text Style? every time i use it, it places Standard text style even though it's not my default.

alanjt 发表于 2022-7-5 17:45:15

 
Oh man, that code is embarrassing!
 
For Leaders/QLeaders, the textstyle is set in the active dimension style. However, you can temporarily override it by setting the DIMTXSTY system variable. Just be sure to reset when done.
All that being said, if you're running 2016, I would hope you are using MLeaders.
页: 1 [2]
查看完整版本: 东距和北距Lisp路由