曲线引线调整

chelsea1307 · 发表于 2022-7-6 15:18:58

我有一个Lisp程序的领导人我使用。不知怎的，我的尺码变了。在1=1ps中，引线上的箭头应为1/8“长，1/16”宽，在我的代码中，我在哪里更改它？它还需要根据不同的规模进行相应的扩展。对于四分之一刻度，其长度应为6英寸，宽度应为2英寸。如果它不是太多，那么如果它在命令开始时关闭osnaps，然后在命令结束时重新打开它也会很好，如果这太大，那么大小才是真正重要的。任何帮助都会很棒！

copy

;Curved Leader
(defun c:CL ()
  (defun *error* (msg)
     (reset)
     (prompt (strcat "\n\n" msg "  "))
  );defun
  (setq osm (getvar "osmode"))
  (setq layerl (getvar "clayer"))
  (setq ortho (getvar "orthomode"))
  (setvar "orthomode"0)
  (setvar "blipmode"0)
  (setvar "cmdecho"0)
  (if (tblsearch "layer" "txt")
          (command "layer" "s" "txt" "")
          (progn
              (setq rgn (getvar "regenmode")) (setvar "regenmode"0)
              (command "layer" "m" "txt")
              (command "c" "c" "")
              (command "")
              (setvar "regenmode" rgn)
          );progn
      );if
   (princ)
  (setq p1 (getpoint "\nstart: "))
  (setq p2 (getpoint p1 "\nfirst point of curve: "))
     (setq ang (angle p1 p2))
     (setq dimsc (getvar "dimscale"))
     (setq lth (* 0.10125 dimsc))
     (setq pp2 (polar p1 ang lth))
     (setq p02 (polar pp2 (+ ang 1.570796) (/ lth 5.5)))
     (setq p03 (polar pp2 (- ang 1.570796) (/ lth 5.5)))
     (command "pline" p1 "w" "0" "0" p2)
     (while (setq p2 (getpoint "\nto point: " p2))
       (command p2)
     );while
     (command "")
  (princ)
  (command "pedit" "@" "s"  "")
  (command "solid" p1 p02 p03 "" "")
  (if (tblsearch "layer" "txt")
          (command "layer" "s" "txt" "")
          (progn
              (setq rgn (getvar "regenmode")) (setvar "regenmode"0)
              (command "layer" "m" "text")
              (command "c" "4" "")
              (command "")
              (setvar "regenmode" rgn)
          );progn
      );if
   (princ)
   (setvar "osmode"1)
   (setvar "blipmode"0) 
   (setq t1 (getpoint "\nPick end point of leader: "))
   (setvar "osmode" osm)
   (setq t2 (getpoint t1 "\nPick direction for text justification: "))
   (setq ds (/ dimsc 24))
   (if (< (car t2) (car t1))
       (setq t3 (polar t1 (/ 225 57.295) (* ds (sqrt 2.0))))
       (setq t3 (polar t1 (/ 315 57.295) (* ds (sqrt 2.0))))
   );if 
  (prompt "\nEnter Text: ")
   (if (< (car t3) (car t1)) 
       (command "Dtext" "r" t3 "0")
       (command "Dtext" t3 "0")
   );if
  (setvar "orthomode" ortho)
  (command "layer" "s" layerl "")   
  )

Lee Mac · 发表于 2022-7-6 15:29:59

我刚才不是为你们创建了一个可以改变这些变量的模型吗

copy


;|
   Curved Leader
   By Lee McDonnell
   31.12.2008
|;
 ; Version 2  ~  Added Variable Menu.
(defun c:cl () (c:CurvedLeader)) ; Program Shortcut
(defun c:CurvedLeader (/ *error* varlist oldvars pl vlist stpt enpt ang pt ltxt)
   ;;     --- Error Trap ---
   (defun *error* (msg)
   (mapcar 'setvar varlist oldvars)
   (if (= msg "")
       (princ "\nLeader Constructed.")
       (princ (strcat "\n" (strcase msg)))
   ) ;_  end if
   (princ)
   ) ; end of *error*
   (setq varlist (list "CMDECHO" "CLAYER" "PLINEWID")
     oldvars (mapcar 'getvar varlist)
   ) ; end setq 
   ;;     --- Error Trap ---
   (or (getenv "CL:ARROWW") (setenv "CL:ARROWW" "2.0"))
   (or (getenv "CL:ARROWL") (setenv "CL:ARROWL" "4.0"))
   (or (getenv "CL:TEXTH") (setenv "CL:TEXTH" "2.5"))
   (or (getenv "CL:TEXTO") (setenv "CL:TEXTO" "2.5"))
   (alert
   (strcat    "Type "CLSET" to Alter Base Variables.
           \nCurrent Settings: \n\nArrow Width: "
       (getenv "CL:ARROWW")
       "\nArrow Length: "
       (getenv "CL:ARROWL")
       "\nText Height: "
       (getenv "CL:TEXTH")
       "\nText Offset: "
       (getenv "CL:TEXTO")
   ) ;_  end strcat
   ) ;_  end alert
   (defun makelay (x y)
   (if (not (tblsearch "Layer" x))
       (command "-layer" "m" x "c" y x "")
   ) ;_  end if
   ) ;_  end defun
   (defun polyvert (z)
   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget z)))
   ) ;_  end defun
   (setvar "cmdecho" 0)
   (vl-load-com)
   (mapcar 'makelay '("LEADER" "LEADER-TEXT") '("2" "2"))
   (setvar "clayer" "LEADER")
   (prompt "\nConstruct Leader... ")
   (setvar "PLINEWID" 0.0)
   (command "_pline")
   (while (> (getvar "cmdactive") 0) (command pause))
   (setq pl (entlast))
   (setq vlist (polyvert pl))
   (command "_pedit" pl "S" "")
   (setq stpt (car vlist)
     enpt (last vlist)
     ang  (angle stpt (cadr vlist))
   ) ;_  end setq
   (command "_pline"
        stpt
        "W"
        "0.0"
        "2.0"
        (polar stpt ang 4.0)
        ""
   ) ;_  end command
   (setq pt (polar enpt 0 2.5))
   (if    (/= (setq ltxt (getstring t "\nSpecify Text for Leader: ")) "")
   (entmake
       (list '(0 . "TEXT")
         '(8 . "LEADER-TEXT")
         (cons 10 pt)
         (cons 40 2.5)
         (cons 1 ltxt)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 0)
         '(73 . 2)
         (cons 11 pt)
       ) ; end list
   ) ; end entmake
   (alert "Blank Leader Created.")
   ) ;_  end if
   (*error* "")
   (princ)
) ;_  end defun
(princ "\nCurved Leader by Lee McDonnell Loaded. Type "CL" to Invoke.")
(defun c:clset (/ arw arl txth txto)
   (or (getenv "CL:ARROWW") (setenv "CL:ARROWW" "2.0"))
   (or (getenv "CL:ARROWL") (setenv "CL:ARROWL" "4.0"))
   (or (getenv "CL:TEXTH") (setenv "CL:TEXTH" "2.5"))
   (or (getenv "CL:TEXTO") (setenv "CL:TEXTO" "2.5"))
   (alert (strcat "Current Settings: \n\nArrow Width: "
          (getenv "CL:ARROWW")
          "\nArrow Length: "
          (getenv "CL:ARROWL")
          "\nText Height: "
          (getenv "CL:TEXTH")
          "\nText Offset: "
          (getenv "CL:TEXTO")
      ) ;_  end strcat
   ) ;_  end alert
   (if    (setq arw (getreal (strcat "Specify Arrow Width <"
                  (getenv "CL:ARROWW")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:ARROWW" (rtos arw))
   ) ;_  end if
   (if    (setq arl (getreal (strcat "Specify Arrow Length <"
                  (getenv "CL:ARROWL")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:ARROWL" (rtos arl))
   ) ;_  end if
   (if    (setq txth (getreal (strcat "Specify Text Height <"
                   (getenv "CL:TEXTH")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:TEXTH" (rtos txth))
   ) ;_  end if
   (if    (setq txto (getreal (strcat "Specify Text Offset <"
                   (getenv "CL:TEXTO")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:TEXTO" (rtos txto))
   ) ;_  end if
   (princ "\nBase Variables Set.")
   (princ)
) ;_  end defun

chelsea1307 · 发表于 2022-7-6 15:36:18

我很确定你做了，我一直在经历和摆脱旧的口吃，我们有4个弯曲的领导人口吃，我摆脱了正确的一个，并保留了错误的一个。谢谢你再次修复它。

chelsea1307 · 发表于 2022-7-6 15:42:12

它说键入clset来更改变量，当我这样做时，它说输入无效。

Lee Mac · 发表于 2022-7-6 15:49:04

在LISP函数之外键入CLSet-我知道它不太好，但这是一个快速修复方法。

chelsea1307 · 发表于 2022-7-6 15:57:59

有没有办法让它随着比例的变化而变化。

对于四分之一刻度，我使用

copy

(defun c:1=48MS ()
(setvar "tilemode" 1)
(command "-style" "" "" 4.5 ".9" "" "" "" "")
(setvar "ltscale" 18)
(setvar "DIMscale" 48)
(setvar "BLIPMODE" 0)
)
CODE] and the arrows should be 2" wide and 6" long
for eighth scale
[code(defun c:1=96MS ()
(setvar "tilemode" 1)
(command "-style" "" "" 9 ".9" "" "" "" "")
(setvar "ltscale" 36)
(setvar "DIMscale" 96)
(setvar "BLIPMODE" 0)
)

，箭头应为4“x 10”
有没有办法让箭头根据这些值改变大小？

Lee Mac · 发表于 2022-7-6 16:02:50

我可以将箭头大小乘以dimscale集（或dimscale的修改）。

你说，当它为1/4时，你将dimscale设置为48？

chelsea1307 · 发表于 2022-7-6 16:09:31

是的，我想我需要的是把尺寸乘以dimscale

Lee Mac · 发表于 2022-7-6 16:17:15

我想文字高度也需要乘以因子？

Lee Mac · 发表于 2022-7-6 16:21:22

好的，对不起，原来的代码-我没有正确完成菜单-当你设置值时，它们可能对实际的领导者没有影响。

现在已修复：

copy


;|
   Curved Leader
   By Lee McDonnell
   31.12.2008
|;
 ; Version 2  ~  Added Variable Menu.
(defun c:cl () (c:CurvedLeader)) ; Program Shortcut
(defun c:CurvedLeader (/ *error* varlist oldvars dmscal pl vlist stpt enpt ang pt ltxt)
   ;;     --- Error Trap ---
   (defun *error* (msg)
   (mapcar 'setvar varlist oldvars)
   (if (= msg "")
       (princ "\nLeader Constructed.")
       (princ (strcat "\n" (strcase msg)))
   ) ;_  end if
   (princ)
   ) ; end of *error*
   (setq varlist (list "CMDECHO" "CLAYER" "PLINEWID")
     oldvars (mapcar 'getvar varlist)
   ) ; end setq 
   ;;     --- Error Trap ---
   (or (getenv "CL:ARROWW") (setenv "CL:ARROWW" "2.0"))
   (or (getenv "CL:ARROWL") (setenv "CL:ARROWL" "4.0"))
   (or (getenv "CL:TEXTH") (setenv "CL:TEXTH" "2.5"))
   (or (getenv "CL:TEXTO") (setenv "CL:TEXTO" "2.5"))
   (alert
   (strcat    "Type "CLSET" to Alter Base Variables.
           \nCurrent Settings: \n\nArrow Width: "
       (getenv "CL:ARROWW")
       "\nArrow Length: "
       (getenv "CL:ARROWL")
       "\nText Height: "
       (getenv "CL:TEXTH")
       "\nText Offset: "
       (getenv "CL:TEXTO")
   ) ;_  end strcat
   ) ;_  end alert
   (defun makelay (x y)
   (if (not (tblsearch "Layer" x))
       (command "-layer" "m" x "c" y x "")
   ) ;_  end if
   ) ;_  end defun
   (defun polyvert (z)
   (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget z)))
   ) ;_  end defun
   (setvar "cmdecho" 0)
   (vl-load-com)
   (setq dmscal (max 1 (getvar "DIMSCALE")))
   (mapcar 'makelay '("LEADER" "LEADER-TEXT") '("2" "2"))
   (setvar "clayer" "LEADER")
   (prompt "\nConstruct Leader... ")
   (setvar "PLINEWID" 0.0)
   (command "_pline")
   (while (> (getvar "cmdactive") 0) (command pause))
   (setq pl (entlast))
   (setq vlist (polyvert pl))
   (command "_pedit" pl "S" "")
   (setq stpt (car vlist)
     enpt (last vlist)
     ang  (angle stpt (cadr vlist))
   ) ;_  end setq
   (command "_pline"
        stpt
        "W"
        "0.0"
        (rtos (* (atof (getenv "CL:ARROWW")) dmscal))
        (polar stpt ang (* (atof (getenv "CL:ARROWL")) dmscal))
        ""
   ) ;_  end command
   (setq pt (polar enpt 0 (atof (getenv "CL:TEXTO"))))
   (if    (/= (setq ltxt (getstring t "\nSpecify Text for Leader: ")) "")
   (entmake
       (list '(0 . "TEXT")
         '(8 . "LEADER-TEXT")
         (cons 10 pt)
         (cons 40 (* (atof (getenv "CL:TEXTH")) dmscal))
         (cons 1 ltxt)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 0)
         '(73 . 2)
         (cons 11 pt)
       ) ; end list
   ) ; end entmake
   (alert "Blank Leader Created.")
   ) ;_  end if
   (*error* "")
   (princ)
) ;_  end defun
(princ "\nCurved Leader by Lee McDonnell Loaded. Type "CL" to Invoke.")
(defun c:clset (/ arw arl txth txto)
   (or (getenv "CL:ARROWW") (setenv "CL:ARROWW" "2.0"))
   (or (getenv "CL:ARROWL") (setenv "CL:ARROWL" "4.0"))
   (or (getenv "CL:TEXTH") (setenv "CL:TEXTH" "2.5"))
   (or (getenv "CL:TEXTO") (setenv "CL:TEXTO" "2.5"))
   (alert (strcat "Current Settings: \n\nArrow Width: "
          (getenv "CL:ARROWW")
          "\nArrow Length: "
          (getenv "CL:ARROWL")
          "\nText Height: "
          (getenv "CL:TEXTH")
          "\nText Offset: "
          (getenv "CL:TEXTO")
      ) ;_  end strcat
   ) ;_  end alert
   (if    (setq arw (getreal (strcat "Specify Arrow Width <"
                  (getenv "CL:ARROWW")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:ARROWW" (rtos arw))
   ) ;_  end if
   (if    (setq arl (getreal (strcat "Specify Arrow Length <"
                  (getenv "CL:ARROWL")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:ARROWL" (rtos arl))
   ) ;_  end if
   (if    (setq txth (getreal (strcat "Specify Text Height <"
                   (getenv "CL:TEXTH")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:TEXTH" (rtos txth))
   ) ;_  end if
   (if    (setq txto (getreal (strcat "Specify Text Offset <"
                   (getenv "CL:TEXTO")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "CL:TEXTO" (rtos txto))
   ) ;_  end if
   (princ "\nBase Variables Set.")
   (princ)
) ;_  end defun

[编程交流] 曲线引线调整

发表回复

精选推荐