尺寸线lisp！！帮助

prodromosm · 发表于 2022-7-6 06:11:00

我试图完成这个Lisp程序，但我有一个小问题的规模。对于任何小刻度，文本大小都是相同的。我不知道问题出在哪里。有人能帮我吗！
这是我的密码

;;------------------------------------ LINEDIM.LSP ----------------------------------;;
(defun C:LINEDIM(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txtpt1 scl ht)
(command "layer" "m" "diast" "")
(setq scl(/ (getreal  "\n GIVE SCALE (100,200,500,etc) : ") 100))
(setq ht(* 0.175 scl))
 (command "style" "diast" "wgsimpl.shx" "" "" "" "" "")
   (defun *error* (msg)
     (vla-endundomark (vla-get-activedocument
             (vlax-get-acad-object))
      )
   (cond ((or (not msg)
       (member msg '("console break" "Function cancelled" "quit / exit abort"))
       )
   )
  ((princ (strcat "\nError: " msg)))
  )
   (princ)
   )
 
(setq adoc (vla-get-activedocument
             (vlax-get-acad-object))
     acsp (vla-get-block(vla-get-activelayout adoc)))
 
 (vla-startundomark adoc )
 
(setq txh (getvar "dimtxt")
     
     prex (getvar "dimdec")
     )
 
(while (not sset)
 
   (setq sset (ssget '((0 . "*LINE")))
  
  )
 )
 
(while (setq en (ssname sset 0))
 
 (setq curve (vlax-ename->vla-object en))
 
 (setq txt (if (= (getvar "measurement") 0)
      
      (rtos (vla-get-length curve) 2 2)
      
      (rtos (vla-get-length curve) 2 prex))
)
 
 (setq mid (/ (abs (- (vlax-curve-getendparam curve)
                          (vlax-curve-getstartparam curve))) 2.)
mp (vlax-curve-getpointatparam curve mid)
deriv  (vlax-curve-getfirstderiv
         curve
         (vlax-curve-getparamatpoint curve mp))
)
 (if (zerop (cadr deriv))
   (setq ang 0)
   (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv)))))
   )
   (if (< (/ pi 2) ang (* pi 1.5))
   (setq ang (+ pi ang))
   )
;;;  (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5))
;;;        )
 (setq ppt1 (polar mp (+ ang (/ pi 2)) 0.15)
)
 (setq txtpt1  (vlax-3d-point (trans ppt1 1 0)))
;;;  (setq txt1 (vla-addtext acsp txt txtpt1 txh))
 (setq txt1 (vla-addtext acsp (strcat (strcat txt )) txtpt1 txh))
 
 (vla-put-alignment txt1 acalignmentbottomcenter)
 
 (vla-put-textalignmentpoint txt1 txtpt1)
 
 (vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1))
 
 (vla-put-rotation txt1 ang)
(ssdel en sset)
 )
 
 (*error* nil)
 
 (princ)
 )
(princ)
(or (vl-load-com)
   (princ))
;;------------------------------------ code end ----------------------------------;;

CheSyn · 发表于 2022-7-6 06:17:56

这不是“你的”代码。通常，包括原始作者和代码来源的位置是合适的。

几周前你不是要求这样的东西吗？如果我没记错的话，答案就在那条线索里。

试着用LISP展示一下你会做什么，我会非常乐意帮你。

prodromosm · 发表于 2022-7-6 06:28:56

它是两个lisp代码的混合。我没有说这是我的密码。我认为fixo或frixo是一个lisp的作者，我不知道另一个。

prodromosm · 发表于 2022-7-6 06:36:41

有什么想法吗？

Tyke · 发表于 2022-7-6 06:40:22

这句话来自你原来的帖子
. 所以你说这是你的密码。

ketxu · 发表于 2022-7-6 06:50:38

@OP：清除此行：
（可能您的窗口没有这种字体）并添加以下行：
行下方：

copy

 (vla-put-rotation txt1 ang)

ht是文本高度，在代码中：
scl=给定量表（100200500等）/100
ht=0.175 x scl

prodromosm · 发表于 2022-7-6 06:52:46

谢谢你的建议，但我需要这两行代码

我修改了所有代码，然后写了这个

copy

(defun c:linedim(/ scl ht)
(setq scl(/ (getreal  "\n GIVE SCALE (100,200,500,etc) : ") 100))
(setq ht(* 0.175 scl))
(command "style" "diast" "wgsimpl.shx" "" "" "" "" "")
(setq point1 '(0,0,0))
(while point1
(setq point1 (getpoint "Pick the first point :"))
(setq point2 (getpoint "Pick the second point :"))
(setq point3 (getpoint "pick the possition of the text :"))
(setq apost (distance point1 point2))
(setq gon (angle point1 point2))
(setq gon2 (atof (angtos gon 2 2)))
(setq apost2 (rtos apost 2 2))
(command "text" point3 ht gon2 apost2)
)
)