在垂直分布图中创建点

prodromosm · 发表于 2022-7-5 16:20:17

您好，我正在尝试将一个旧帖子中的hanhphuc lisp转换为从像照片一样的直线垂直距离创建一个点。有人能帮我吗？


(defun c:test (/ os asin _line p1 p2 d2 l1 ad d ok p ang d3 dir ip )
; hanhphuc 25.02.2015
(COMMAND "_layer" "_m" "new_point" "_c" "10" "" "")
(setvar 'pdmode 35)
 (setq os    (getvar 'osmode)
asin  '((x) (atan (/ x (sqrt (+ 1.0 (* x (- x)))))))
_line '((a lst) (foreach x lst (entmake (list '(0 . "LINE") (cons 10 a) (cons 11 x)))))
) ;_ end of setq
 (setvar 'osmode 1)
 (if (and (setq p1 (getpoint "\nPick point A: "))
   (setq p2 (getpoint p1 "\nPick point B: "))
   (setq d2 (getdist p2 "\nInput perpendicular length: "))   
   (setq l1  (list p1 p2)
         ad  (mapcar ''((x) (apply x l1)) '(angle distance))
         d   (cadr ad)
         ok (< d2 d))
   (setq p (getpoint "\nPick side to draw.. "))
   ) ;_ end of and
   (progn (setq ang (asin (/ d2 d))
         d3  (* d (cos ang))
         dir (car ad)
         ip  (apply 'if
                    (vl-list*
                              (minusp (- (* (- (cadr p) (cadr p1)) (cos dir)) (* (- (car p) (car p1)) (sin dir))))
                              (mapcar ''((f) (polar p1 ((eval f) dir ang) d3)) '(- +))
                              ) ;_ end of vl-list*
                    ) ;_ end of apply
         ) ;_ end of setq
   (_line ip l1)
   ) ;_ end of progn
(if (not ok)  (alert "Perpendicular line exceeds length of A to B!") )
   ) ;_ end of if
 (setvar 'osmode os)
(command "setvar" "clayer" "0")
 (princ)
 ) ;_ end of defun

谢谢

BIGAL · 发表于 2022-7-5 16:50:12

对于一个简单的任务，有很多代码可以考虑这样做：设置角度单位和角度方向查看单位，设置变量angdir和aunits，选择p1，选择p2，获取角度，不需要选择边，因为你总是在角度上加90，但对边方向使用正值或负值。然后，新点只是来自pt2的极坐标。“极轴”命令允许负距离，因此将以与角度相反的方向绘制。

copy


(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "AUNITS" 3)
(SETVAR "AUPREC" 6)
(setvar 'osmode 512)
(setq pt1 (getpoint "Pick point A"))
(setq pt2 (getpoint "pick point B"))
(setq ang (angle pt1 pt2))
(setq dist (getreal "Enter dist + for left - for right"))
(setq pt3 (polar pt2 (+ (/ pi 2.0) ang) dist))
(command "line" pt2 pt3 "")

prodromosm · 发表于 2022-7-5 16:52:54

嗨，比格尔。谢谢你的重播。我对你的代码做了同样的修改。是否可以只创建点而不创建线？

copy


(defun c:test (/ pt1 pt2 pt3 ang dist )
(COMMAND "_layer" "_m" "new_point" "_c" "10" "" "")
(setvar 'pdmode 35)
(setvar "unitmode" 0)
(setvar "aunits" 2)
(setvar "angbase" (/ pi 2))
(setvar "angdir" 1)
(setvar "auprec" 4)
(setvar "lunits" 2)
(setvar "luprec" 3)
(setvar "dimzin" 0)
(setq pt1 (getpoint "Pick point A"))
(setq pt2 (getpoint "pick point B"))
(setq ang (angle pt1 pt2))
(setq dist (getreal "Enter dist + for left - for right"))
(setq pt3 (polar pt2 (+ (/ pi 2.0) ang) dist))
(command "line" pt2 pt3 "")
(command "setvar" "clayer" "0")
(princ)
)

谢谢

prodromosm · 发表于 2022-7-5 17:19:59

我修好了。谢谢

copy

(defun c:test (/ pt1 pt2 pt3 ang dist )
(COMMAND "_layer" "_m" "new_point" "_c" "10" "" "")
(setvar 'pdmode 35)
(setvar "unitmode" 0)
(setvar "aunits" 2)
(setvar "angbase" (/ pi 2))
(setvar "angdir" 1)
(setvar "auprec" 4)
(setvar "lunits" 2)
(setvar "luprec" 3)
(setvar "dimzin" 0)
(setq pt1 (getpoint "Pick point A"))
(setq pt2 (getpoint "pick point B"))
(setq ang (angle pt1 pt2))
(setq dist (getreal "Enter dist + for left - for right"))
(setq pt3 (polar pt2 (+ (/ pi 2.0) ang) dist))
;(command "line" pt2 pt3 "")
(command "point" pt3 "")
(command "setvar" "clayer" "0")
(princ)
)

BIGAL · 发表于 2022-7-5 17:21:53

您应该在开始时添加保存现有单位设置，然后在结束时恢复，如果它们与您通常使用的不同。

copy


(setq oldsnap (getvar "osmode"))
.....
(setvar "osmode" oldsnap)

[编程交流] 在垂直分布图中创建点

发表回复

精选推荐