编程申请]：求LSP程序，选定字符，回车，字符沿与该字符平行方向移动750

lengliqun

求LSP程序，选定字符，回车，字符沿与该字符平行方向移动750

自由的鱼

怎么个平行法？

lsjjm

最初由 lengliqun 发布
[B]求LSP程序，选定字符，回车，字符沿与该字符平行方向移动750 [/B]

你说的是水平方向移动吗? 请参考:
[php]
(defun c:test ()
  ;(vl-load-com)
  (setq dis (getreal "\nInput Moving Distance: "))
  (prompt "\nSelect Text: ")
  (setq ss (ssget '((0 . "*TEXT"))) n 0)
  (while (< n (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss n)))
    (setq p0  (vlax-safearray->list
                (variant-value (vla-get-insertionpoint obj))))
    (vla-put-insertionpoint obj (vlax-3d-point (polar p0 0 dis)))
    (setq n (1+ n))
  )
)
[/php]

lengliqun

谢谢lsjjm .强烈要求将distance “750”加入到您的LSP程序中。

lsjjm

最初由 lengliqun 发布
[B]谢谢lsjjm .强烈要求将distance “750”加入到您的LSP程序中。 [/B]

不写750是适用性更强些. 按照你的要求, 将
(setq dis (getreal "\nInput Moving Distance: ")) 换成(setq dis 750) 即可.

lengliqun

报告，R2002下可用，R14下不可用，提示：
选择对象:

错误: 空函数
nil*取消*
我单位用R14，能改成R14下可用的LSP程序吗？期待中......

eachy

最初由 lengliqun 发布
[B]报告，R2002下可用，R14下不可用，提示：
选择对象:

错误: 空函数
nil*取消*
我单位用R14，能改成R14下可用的LSP程序吗？期待中...... [/B]

2. 
   
3. (defun c:test (/ ss e an ssl)
   
4.   (if (setq ss (ssget '((0 . "*text"))))
   
5.     (progn
   
6.       (command ".undo" "g")
   
7.       (setq ssl (sslength ss))
   
8.       (while (> ssl 0)
   
9.         (setq e         (ssname ss (setq ssl (1- ssl)))
   
10.               an (strcat
    
11.                    "@750<"
    
12.                    (rtos (* (/ (cdr (assoc 50 (entget e))) pi) 180.) 2 8)
    
13.                  )
    
14.         )
    
15.         (command ".move" e "" "_non" "0,0,0" "_non" an)
    
16.       )
    
17.       (command ".undo" "end")
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )
    

<br /> (defun c:test (/ ss e an ssl)<br />   (if (setq ss (ssget '((0 . "*text"))))<br />     (progn<br />       (command ".undo" "g")<br />       (setq ssl (sslength ss))<br />       (while (> ssl 0)<br />         (setq e         (ssname ss (setq ssl (1- ssl)))<br />               an (strcat<br />                    "@750<"<br />                    (rtos (* (/ (cdr (assoc 50 (entget e))) pi) 180.) 2 8)<br />                  )<br />         )<br />         (command ".move" e "" "_non" "0,0,0" "_non" an)<br />       )<br />       (command ".undo" "end")<br />     )<br />   )<br />   (princ)<br /> )<br />

lsjjm

当然R14(其实R14.01可用)下不能用. 正打算写呢, 不过好了有eachy斑竹贴了R14的...

f5612140

(defun c:test ()
  (setq selnum (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ss (ssget '((0 . "*TEXT"))))
  (command "move" ss "" '(0 0 0)  '(750 0 0))
  (setvar "osmode" selnum)
  (prin1)
)

coolzhb

最初由 eachy 发布
[B]
[CODE]
(defun... [/B]

用它来移动网架平面图中的杆件标注太方便了，以前我是通过加前缀空格来实现的，没想到用移动更妙，收藏了！

lengliqun

谢谢在家的关心，感谢所有帮助我的人和愿意帮我的人，谢谢啦。