如何选择一侧（即左侧
大家好，以前有相当数量的赖斯普鲁丁，但当我换了工作（十年前…）时，它就全丢了和LT。
现在我正试图写（重新创建）一个lisp，但我的记忆已经不是以前的样子了。。。这可能很简单，我试着在论坛上查找，但找不到。。。
我想要的是：有一条线，你选择起点和终点，你点击线的一边或另一边，在这条线的选中一边它画出一些东西。。。
见附件：一条线（pt1和pt2）和一个点，可以在这条线的任一侧（即，如果它是一条垂直线，则为左侧或右侧），我画了一个圆圈来表示两个可能的象限，在这种情况下为左侧和右侧。大多数线条是垂直的，但在某些情况下，线条可以处于不同的角度。
选择这三个点后，lisp将以设定的距离（以红色绘制）绘制一组与主线垂直和平行的线。
我的问题是，我无法思考如何选择线的哪一边。我很确定这很简单，但我不记得是怎么做的。
这就是我目前所拥有的。我可以选择三个点，我可以画线，但在计算角度时出现了一些错误，它画的线基本上不是我想要的位置。。。
(defun C:HH()
(defun RTD (nbrOfRadians) ;convert to degrees
(* 180.0 (/ nbrOfRadians pi))
);defun RTD
(defun DTR (a) ;convert to radians
(* pi (/ a 180.0))
);defun DTR
(setqOLDECHO (getvar "CMDECHO");store system variables
OLDBLIP (getvar "BLIPMODE")
OLDSNAP (getvar "OSMODE")
);setq
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setq P1 nil P2 nil P3 nil P4 nil );setq Zorgt dat P1 etc nil zijn
(setq pt1(getpoint "\n Startpoint: "));store base point
(setq pt2(getpoint "\n Endpoint: "))
(setq a-rad1 (angle pt1 pt2)) ;angle in radians
(setq a-deg1 (RTD a-rad1)) ;angle in degrees
(setq pt3(getpoint "\n On which side of the line would like to draw?: "))
;
(setq a-rad2 (angle pt1 pt3)) ;angle in radians
(setq a-deg2 (RTD a-rad2))
(setq Diff-deg1-2 (- a-deg1 a-deg2))
(COND((< 90 Diff-deg1-2) ;Als het links van de pt1-pt2 lijn is
(setq hoek1 (DTR 180.0))
(setq hoek2 (DTR 0.0))
(setq hoeka (RTD Hoek1))
(setq hoekb (RTD hoek2)))
((> 90 Diff-deg1-2);Als het rechts van de pt1-pt2 lijn is
(setq hoek1 (DTR 0.0))
(setq hoek2 (DTR 180.0))
(setq hoeka (RTD hoek1))
(setq hoekb (RTD hoek2)))
);end cond 1=links 2=rechts
;(setq hoek1 (+ a-rad1 hoek1))
;(setqhoek2 (+ a-rad1 hoek2))
;(setq hoeka (RTD Hoek1))
;(setq hoekb (RTD hoek2))
(setq Lengte (distance pt1 pt2))
(setq Lagen (/ (/ lengte 2) 60)); waarbij
(command "_UCS" "_n" "z" a-deg1)
(setvar "OSMODE" 0)
(setqP1 (polar pt1 hoek1 165)
P2 (polar P1 (DTR 90.0) 60)
P3 (polar P2 hoek2 165)
P4 (polar P3 (DTR 90.0) 60)
);setq
(command "PLINE" pt1 "W" "0.0" "0.0" P1 P2 P3 P4""
);command
(setq cntr 1) ;setup counter
(while (< cntr lagen);loop until cntr is not less than lagen
(command "copy" "last" "" pt1P4
);command
(setq cntr(+ cntr 1)) ;increment the counter
);while
(setq cntr 1) ;Reset counter
(command "_UCS" "_p" "" );reset ucs to previous
(setvar "OSMODE" OLDSNAP)
(setvar "BLIPMODE" OLDBLIP)
(setvar "CMDECHO" OLDECHO)
(princ)
);end defun
(princ)
所以我的问题是，有人能解决我的问题吗？它在驱使我。。。我知道我很接近，但到目前为止。。。
谢谢你看！
如果有人想知道的话，我正在制作建筑物的比例模型，这些模型在细节上非常精细。这意味着每一块砖都必须到位。我有正确的图案填充来绘制砖的图案，但有一些规则是如何做角的，这不能在图案填充中捕捉到。通过更改图案填充边界，这个lisp将极大地帮助我实现这一点。
嘴唇应该做什么的例子。dxf 不同的方法
(defun c:test (/ ent obj pt_pick pt1 osm_old pt_start
pt_endpt2 num pt3 pt4 pt5 pt6
)
(vl-load-com)
(setq ent(entsel "\nSelect the line near the brick base : ")
obj(vlax-ename->vla-object (car ent))
pt_pick(cadr ent)
pt1(getpoint "\nPick the desired side: ")
osm_old(getvar "OSMODE")
pt_start (vlax-curve-getStartPoint obj)
pt_end(vlax-curve-getEndPoint obj)
pt2(vlax-curve-getClosestPointTo obj pt1 T)
num(fix (- (/ (/ (vla-get-Length obj) 60) 2) 0.5))
)
(setvar "OSMODE" 0)
(if (< (distance pt_end pt_pick) (distance pt_start pt_pick))
(progn
(setq pt_start pt_end
pt_end (vlax-curve-getStartPoint obj)
)
)
)
(setq pt3 (polar pt_start (angle pt2 pt1) 165)
pt4 (polar pt3 (angle pt_start pt_end) 60)
pt5 (polar pt4 (angle pt1 pt2) 165)
pt6 (polar pt5 (angle pt_start pt_end) 60)
)
(command "PLINE" pt_start "W" "0.0" "0.0" pt3 pt4 pt5 pt6 "")
(repeat num (command "copy" "last" "" pt_start Pt6))
(setvar "OSMODE" osm_old)
(princ)
)
希望有帮助
亨里克 这看起来是一个有趣的程序，所以我尝试了一个“动态”版本：
;; Dynamic Zig-Zag-Lee Mac
(defun c:hh ( / ang dis ent gr1 gr2 inc len lst ocs pt1 pt2 spc tmp )
(setq spc60.0 ;; Spacing
len 165.0 ;; Length
)
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Line: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent)
nil
)
( (/= "LINE" (cdr (assoc 0 (setq ent (entget ent)))))
(princ "\nSelected object is not a Line.")
)
( t
(setq pt1 (trans (cdr (assoc 10 ent)) 0 1)
pt2 (trans (cdr (assoc 11 ent)) 0 1)
dis (distance pt1 pt2)
inc (/ pi 2.0)
ang (angle pt1 pt2)
)
(princ "\nChoose Side [</>/-/+] <Exit>: ")
(while
(progn
(setq gr1 (grread t 15 0)
gr2 (cadr gr1)
gr1 (cargr1)
)
(cond
( (or (= 3 gr1) (= 5 gr1))
(setq tmp pt1
inc (abs inc)
)
(if (minusp (sin (- (angle pt1 gr2) ang)))
(setq inc (- inc))
)
(redraw)
(repeat (* 2 (fix (/ (1+ (/ dis spc)) 2)))
(grdraw tmp (setq tmp (polar tmp (+ ang inc) len)) 1 1)
(grdraw tmp (setq tmp (polar tmp ang spc)) 1 1)
(setq inc (- inc))
)
(= 5 gr1)
)
( (= 2 gr1)
(cond
( (or (= 45 gr2) (= 95 gr2))
(setq spc (* 0.9 spc))
)
( (or (= 43 gr2) (= 61 gr2))
(setq spc (* 1.1 spc))
)
( (or (= 46 gr2) (= 62 gr2))
(setq len (* 0.9 len))
)
( (or (= 44 gr2) (= 60 gr2))
(setq len (* 1.1 len))
)
( (or (= 32 gr2) (= 13 gr2))
nil
)
( t )
)
)
)
)
)
(redraw)
(if (= 3 gr1)
(progn
(setq inc (abs inc)
ocs (trans '(0.0 0.0 1.0) 1 0 t)
)
(if (minusp (sin (- (angle pt1 gr2) ang)))
(setq inc (- inc))
)
(repeat (* 2 (fix (/ (1+ (/ dis spc)) 2)))
(setq lst (cons (cons 10 (trans pt1 1 ocs)) lst)
lst (cons (cons 10 (trans (setq pt1 (polar pt1 (+ ang inc) len)) 1 ocs)) lst)
lst (cons (cons 10 (trans (setq pt1 (polar pt1 ang spc)) 1 ocs)) lst)
inc (- inc)
)
)
(entmake
(append
(list
'(000 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
'(070 . 0)
)
lst
(list (cons 210 ocs))
)
)
nil
)
)
)
)
)
)
(princ)
)
上述操作也应在所有UCS和视图中成功执行。 一种不同的方法，你不需要第二次选择想要的一面
在提示消息中，你说“拾取左手端”，这意味着哪个是上下，在v中，然后像上面的代码一样，比较到端的距离，并开始计算正确的“左手”端，通过一些练习，你习惯于拾取方向颠倒的线。 大家好，谢谢你们的回复！这对我帮助很大。已经离开几天了，昨天看到了代码，但是我的acad机器够不着。。。等不及我回来测试代码了！
@嗯，席尔瓦，谢谢你，又好又短，正是我想要它做的！虽然这也意味着我需要阅读我的Vlisp。。。这肯定会帮助我。
@李还感谢你的努力，这看起来非常流畅，虽然我仍然需要深入研究，以找出这段代码中的内容！但是，能够在所见即所得模式下选择一个边，这是非常好的！
现在我需要尝试将其合并到我的Lisp程序中。谢谢大家
页:
[1]