增加输入高程功能

gaics

wanhongron 发表于 2023-6-6 18:00
@gaics侠，感谢你的指点，可是本人比较笨拙，麻烦在我上传的源程序上帮改下

看不懂

wanhongron

;画多段线垂线
(defun c:CCX(/ e p d)
(setq ss (ssadd))
  (setq d 10);定义垂线长度
  (setq e(car(entsel "\n拾取基准线")))
    (while(setq p(getpoint "\n垂足位置"))
      (setq zz (getreal "\n输入高程："))
      (entmakex ( list'(0 . "LINE")
                 (cons 10(setq p(vlax-curve-getclosestpointto e p)))
                 (cons 11(polar p(+(angle p(mapcar'+(vlax-curve-getfirstDeriv e(vlax-curve-getParamAtPoint e p))p))(* pi 0.5))d))))
(ssadd (entlast) ss)

    )
(command "_pedit" "M" ss """y""w""0""j""""")
  (princ)
)

wanhongron

高手谦虚啦，我感觉不知道从哪里下手，就想能把输入的高程ZZ赋给生成的垂线，看看怎么改？

gaics

wanhongron 发表于 2023-6-6 20:53
高手谦虚啦，我感觉不知道从哪里下手，就想能把输入的高程ZZ赋给生成的垂线，看看怎么改？

2. (defun c:CCX (/ e p d zz p1)
   
3.   (setq ss (ssadd))
   
4.   (setq d 10)
   
5.   (setq e (car (entsel "\n拾取基准线")))
   
6.   (while (setq p (getpoint "\n垂足位置"))
   
7.     (setq zz (getreal "\n输入高程："))
   
8.     (setq p (vlax-curve-getclosestpointto e p))
   
9.     (setq p1
   
10.      (polar p
    
11.       (+ (angle p
    
12.           (mapcar '+
    
13.             (vlax-curve-getfirstDeriv
    
14.               e
    
15.               (vlax-curve-getParamAtPoint e p)
    
16.             )
    
17.             p
    
18.           )
    
19.          )
    
20.          (* pi 0.5)
    
21.       )
    
22.       d
    
23.      )
    
24.     )
    
25.     (entmakex
    
26.       (list
    
27.   '(0 . "LINE")
    
28.   (cons 10 (list (car p) (cadr p) zz))
    
29.   (cons 11 (list (car p1) (cadr p1) zz))
    
30.       )
    
31.     )
    
32.   )
    
33.   (princ)
    
34. )

(defun c:CCX (/ e p d zz p1)<br />   (setq ss (ssadd))<br />   (setq d 10)<br />   (setq e (car (entsel "\n拾取基准线")))<br />   (while (setq p (getpoint "\n垂足位置"))<br />     (setq zz (getreal "\n输入高程："))<br />     (setq p (vlax-curve-getclosestpointto e p))<br />     (setq p1<br />      (polar p<br />       (+ (angle p<br />           (mapcar '+<br />             (vlax-curve-getfirstDeriv<br />               e<br />               (vlax-curve-getParamAtPoint e p)<br />             )<br />             p<br />           )<br />          )<br />          (* pi 0.5)<br />       )<br />       d<br />      )<br />     )<br />     (entmakex<br />       (list<br />   '(0 . "LINE")<br />   (cons 10 (list (car p) (cadr p) zz))<br />   (cons 11 (list (car p1) (cadr p1) zz))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

新生成的线段貌似无法合并，暂时移除pedit命令。

wanhongron

@gaics大侠，果然深藏不露，正式我需要的效果，非常感谢大侠的热心帮助