选择中点和端点d
选择中点和端点绘制线。有这样的例行公事吗 我有这个版本：
(defun c:mlp ( / p1 p2 l ll p1p p2p a loop g p pp ppp10 pp11 ppp11 )
(setq p1 (trans (getpoint "\nPick start point") 1 0))
(setq p2 (trans (getpoint "\nPick end point" (trans p1 0 1)) 1 0))
(setq l (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))))
(setq ll (entget l))
(setq ll (subst (cons 10 (mapcar '- p1 (mapcar '- p2 p1))) (assoc 10 ll) ll))
(entmod ll)
(entupd l)
(prompt "\nENTER - continue stretching; ESC - keep drawn line")
(getstring)
(setq p1p (list (car (trans p1 0 1)) (cadr (trans p1 0 1)) 0.0))
(setq p2p (list (car (trans p2 0 1)) (cadr (trans p2 0 1)) 0.0))
(setq a (angle p1p p2p))
(setq loop t)
(while loop
(setq g (grread t 15 0))
(if (eq (car g) 5)
(progn
(setq p (cadr g))
(setq pp11 (inters p1p p2p p (polar p (+ a (* 0.5 pi)) 1.0) nil))
(setq ppp11 (inters (trans p1 0 1) (trans p2 0 1) pp11 (mapcar '+ pp11 '(0.0 0.0 1.0)) nil))
(setq ppp10 (mapcar '- (trans p1 0 1) (mapcar '- (trans ppp11 0 1) (trans p1 0 1))))
(setq ll (subst (cons 10 (trans ppp10 1 0)) (assoc 10 ll) ll))
(setq ll (subst (cons 11 (trans ppp11 1 0)) (assoc 11 ll) ll))
(entmod ll)
(entupd l)
(redraw)
)
(setq loop nil)
)
)
(princ)
)
HTH，M.R。 要使用动态图形，您将松开捕捉对象，下面是它
(defun c:Test (/ c g 1p a d)
;; Tharwat .7.May.2014 ;;
(if (setq c (getpoint "\n Specify Midpoint :"))
(while (eq (car (setq g (grread t 15 0))) 5)
(redraw)
(grvecs (list -3
c
(setq 1p (polar c
(setq a (angle c (cadr g)))
(setq d (distance c (cadr g)))
)
)
1p
(setq 2p (polar 1p (+ a pi) (* d 2.)))
)
)
)
)
(if (eq (car g) 3)
(entmake (list '(0 . "LINE") (cons 10 1p) (cons 11 2p)))
)
(redraw)
(princ)
) 如果要使用（grread）进行快照，可以尝试以下操作：
(defun c:mlpp ( / *error* _acapp _getosmode _grX _OLE->ACI _OLE->RGB _RGB->ACI _snap _polarangs _polar _ortho as ape osm g p1 p2 p3 p0 o p s len nlen )
(vl-load-com)
(defun *error* ( msg )
(if ape (setvar 'aperture ape))
(if as (setvar 'autosnap as))
(if osm (setvar 'osmode osm))
(if msg (prompt msg))
(princ)
)
(defun _acapp nil
(eval (list 'defun '_acapp 'nil (vlax-get-acad-object)))
(_acapp)
)
(defun _getosmode ( os / lst )
(foreach mode
'(
(0001 . "_end")
(0002 . "_mid")
(0004 . "_cen")
(0008 . "_nod")
(0016 . "_qua")
(0032 . "_int")
(0064 . "_ins")
(0128 . "_per")
(0256 . "_tan")
(0512 . "_nea")
(1024 . "_qui")
(2048 . "_app")
(4096 . "_ext")
(8192 . "_par")
)
(if (not (zerop (logand (car mode) os)))
(setq lst (cons "," (cons (cdr mode) lst)))
)
)
(apply 'strcat (cdr lst))
)
(defun _grX ( p s c / -s r j )
(setq -s (- s)
r (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
j p
)
(grdraw (mapcar '+ j (list (* r -s) (* r -s))) (mapcar '+ j (list (* r s) (* r s))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r (1+ -s)))) (mapcar '+ j (list (* r (1- s)) (* r s))) c)
(grdraw (mapcar '+ j (list (* r (1+ -s)) (* r -s))) (mapcar '+ j (list (* r s) (* r (1- s)))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r s))) (mapcar '+ j (list (* r s) (* r -s))) c)
(grdraw (mapcar '+ j (list (* r -s) (* r (1- s)))) (mapcar '+ j (list (* r (1- s)) (* r -s))) c)
(grdraw (mapcar '+ j (list (* r (1+ -s)) (* r s))) (mapcar '+ j (list (* r s) (* r (1+ -s)))) c)
p
)
(defun _OLE->ACI ( c )
(apply '_RGB->ACI (_OLE->RGB c))
)
(defun _OLE->RGB ( c )
(mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 )
)
(defun _RGB->ACI ( r g b / c o )
(if (setq o (vla-getinterfaceobject (_acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
(vlax-release-object o)
(if (vl-catch-all-error-p c)
(prompt (strcat "\nError: " (vl-catch-all-error-message c)))
c
)
)
)
)
(defun _snap ( p osm )
(if (osnap p (_getosmode osm))
(osnap p (_getosmode osm))
p
)
)
(defun _polarangs ( ang / n k a l )
(if (/= ang 0.0)
(progn
(setq n (/ 360.1 (cvunit ang "radians" "degrees")))
(setq k -1.0)
(repeat (1+ (fix n))
(setq a (* (setq k (1+ k)) ang))
(setq l (cons a l))
)
l
)
(list 0.0)
)
)
(defun _polar ( p0 p flag ang / a b an )
(if flag
(progn
(setq a (car (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
(setq b (last (vl-sort (_polarangs ang) '(lambda ( a b ) (< a (angle p0 p) b)))))
(if (< (abs (- (angle p0 p) a)) (abs (- (angle p0 p) b))) (setq an a) (setq an b))
(inters p0 (polar p0 an 1.0) p (polar p (+ an (* 0.5 pi)) 1.0) nil)
)
p
)
)
(defun _ortho ( p0 p flag )
(if flag
(_polar p0 p t (* 0.5 pi))
p
)
)
(setq p1 (getpoint "\nPick or specify mid point : "))
(setvar 'orthomode 1)
(setq ape (getvar 'aperture))
(setvar 'aperture 40)
(setq as (getvar 'autosnap))
(setvar 'autosnap 31)
(setq osm (getvar 'osmode))
(setvar 'osmode 15359)
(if (eq (getvar 'orthomode) 1) (setq o t) (setq o nil))
(if (eq (logand (getvar 'autosnap)8) (setq p t) (setq p nil))
(if (eq (logand (getvar 'autosnap) 16) 16) (setq s t) (setq s nil))
(while (not (or (eq (car (setq g (grread t 15 0))) 3) (eq (car g) 25) (eq (car g) 11)))
(redraw)
(if (listp (cadr g)) (setq p2 (cadr g) p3 (cadr g)))
(cond
( (eq (cadr g) 15)
(if (eq o t) (setq o nil) (setq o t))
)
( (eq (cadr g) 21)
(if (eq p t) (setq p nil) (setq p t))
)
( (eq (cadr g) 6)
(if (eq s t) (setq s nil) (setq s t))
)
)
(cond
( (and o p s)
(setq p2 (_snap (_ortho p1 p2 t) (getvar 'osmode)))
)
( (and o (not p) s)
(setq p2 (_snap (_ortho p1 p2 t) (getvar 'osmode)))
)
( (and (not o) p s)
(setq p2 (_snap (_polar p1 p2 t (getvar 'polarang)) (getvar 'osmode)))
)
( (and (not o) (not p) s)
(setq p2 (_snap p2 (getvar 'osmode)))
)
( (and o p (not s))
(setq p2 (_ortho p1 p2 t))
)
( (and o (not p) (not s))
(setq p2 (_ortho p1 p2 t))
)
( (and (not o) p (not s))
(setq p2 (_polar p1 p2 t (getvar 'polarang)))
)
( (and (not o) (not p) (not s))
(setq p2 p2)
)
)
(if (not (equal p2 p3 1e-6))
(_grX p2 (atoi (getenv "AutoSnapSize")) (_OLE->ACI (if (= 1 (getvar 'cvport)) (atoi (getenv "Layout AutoSnap Color")) (atoi (getenv "Model AutoSnap Color")))))
)
(setq p0 (mapcar '- p1 (mapcar '- p2 p1)))
(grdraw p0 p2 1 1)
)
(entmake (list '(0 . "LINE") (cons 10 (trans p0 1 0)) (cons 11 (trans p2 1 0))))
(setq len (distance p0 p2))
(prompt (strcat "\nCurrent length is : " (rtos len 2 15)))
(initget 6)
(setq nlen (getdist (strcat "\nPick or specify new length <" (rtos len 2 15) "> : ")))
(if nlen (command "_.scale" (entlast) "" "_non" p1 "_R" len nlen))
(redraw)
(*error* nil)
)
HTH，M.R。
谢谢你的Tharwat，代码不错。但是
1、无法输入行长。
2、无法切换正交和极轴。
谢谢你，马尔科，有三个问题。
1、仅使用正交模式。
2.将自动取消“自动捕捉设置”。
3、无法输入行长度。
1.你可以用F8键打开或关闭正交模式，用F10键你可以打开或关闭极轴追踪，用F3键你可以打开或关闭osnaps。。。
2.我不理解这一点-只需检查（logand（getvar'autosnap）=8和（logand（getvar'autosnap）16）=16。。。如果是这种情况，则注释掉行（setvar'autosnap 31）
3.是的，您不能输入长度，因为此代码使用（grread）获取终点。。。
M、 R。 嗨，塔瓦特和马尔科，谢谢，我真的需要这个（输入行长度），我希望你能为我优化它。可以Osnap，可以进入。 我修改了上一个代码以接受长度输入。。。我希望这将帮助你现在。。。
M、 R。
谢谢你的辛勤工作，马尔科，但当你进入极地时，必须按F10+F8，
我已经习惯了……
页:
[1]
2