[LISP]求助,一个画Pline线,并自动移屏的函数

小狼 · 发表于 2004-8-19 20:19:00

我要要一个画Plien线的函数，最好不用Pline命令，并且在话到屏幕边缘时，能自动将最近画的点位移至屏幕中间。
希望能有高手帮我写一个

alin · 发表于 2004-8-19 21:43:00

(DEFUN C:PP (/ oldEcho FirstPt ptlst NextPt)
(setq oldEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq FirstPt (GETPOINT "\nFirst point: "))
(setq ptlst (list FirstPt))
(while FirstPt
(setq NextPt (getpoint FirstPt "\nNext point: "))
(if NextPt
(progn
(command "zoom" "c" NextPt "")
(setq ptlst (cons NextPt ptlst))
(GrVecs (getvlist ptlst))
)
)
(setq FirstPt NextPt)
)
(if (> (length ptlst) 1)
(progn
(command "pline")
(foreach pt ptlst
(command pt))
(command "")
)
)
(setvar "CMDECHO" oldEcho)
(princ)
)
;;;;;--------------------------
(defun getvlist (lst / RetLst idx)
(setq idx 0)
(repeat (1- (length lst))
(setq RetLst
(append
RetLst
(list (list (car (nth idx lst)) (cadr (nth idx lst))))
(list (list (car (nth (1+ idx) lst))
(cadr (nth (1+ idx) lst))))))
(setq idx (1+ idx))
)
RetLst
)

(DEFUN C:PP   (/ oldEcho FirstPt ptlst NextPt)
   (setq oldEcho (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (setq FirstPt (GETPOINT "\nFirst point: "))
   (setq ptlst (list FirstPt))
   (while FirstPt
       (setq NextPt (getpoint FirstPt "\nNext point: "))
       (if  NextPt
           (progn
  (command "zoom" "c" NextPt "")
  (setq ptlst (cons NextPt ptlst))
  (GrVecs (getvlist ptlst))
  )
           )
       (setq FirstPt NextPt)
       )
   (if (> (length ptlst) 1)
       (progn
           (command "pline")
           (foreach pt   ptlst
  (command pt))
           (command "")
           )
       )
   (setvar "CMDECHO" oldEcho)
   (princ)
   )
;;;;;--------------------------
(defun getvlist   (lst / RetLst idx)
   (setq idx 0)
   (repeat (1- (length lst))
       (setq RetLst
       (append
           RetLst
           (list (list (car (nth idx lst)) (cadr (nth idx lst))))
           (list (list (car (nth (1+ idx) lst))
       (cadr (nth (1+ idx) lst))))))
       (setq idx (1+ idx))
       )
   RetLst
   )

wb0815 · 发表于 2004-8-20 18:11:00

好程序

小狼 · 发表于 2004-8-20 19:46:00

不好意思,不是很完善哦,提两点意见可以吗? 1.在每次输入点位的时候，都进行从新定位，速度很慢，特别是带有影象的时候
2.没有回推，和闭合选项，画线工具不完美建议: 1.根据屏幕高度和当前点位的一定比例(比如当前点位到了屏幕上方多少,移屏),将当前屏幕中点移至当前点位. 2.用Entmod生成实体速度比较快

wb0815 · 发表于 2004-8-20 20:03:00

提的好啊

alin · 发表于 2004-8-23 12:17:00

I suggest you use the wheel on your mouse...

(DEFUN C:PP (/ oldEcho FirstPt ptlst NextPt)
(setq oldEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq FirstPt (GETPOINT "\nFirst point: "))
(setq ptlst (list FirstPt))
(while FirstPt
(setq NextPt (getpoint FirstPt "\nNext point: "))
(if NextPt
(progn
(if (ChkCloseToEdge NextPt 0.9)
(command "zoom" "c" NextPt ""))
(setq ptlst (cons NextPt ptlst))
(GrVecs (getvlist ptlst))
)
)
(setq FirstPt NextPt)
)
(if (> (length ptlst) 1)
(EntMakeLWPolyline ptlst)
)
(setvar "CMDECHO" oldEcho)
(princ)
)
;;;;;--------------------------
(defun getvlist (lst / RetLst idx)
(setq idx 0)
(repeat (1- (length lst))
(setq RetLst
(append
RetLst
(list (list (car (nth idx lst)) (cadr (nth idx lst))))
(list (list (car (nth (1+ idx) lst))
(cadr (nth (1+ idx) lst))))))
(setq idx (1+ idx))
)
RetLst
)
;;;
(defun ChkCloseToEdge (p th / vc vx vy)
(setq vc (getvar "VIEWCTR")
vy (getvar "VIEWSIZE")
vx (* vy
(/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE")))))
(if (and (< (- (car vc) (* th vx 0.5))
(car p)
(+ (car vc) (* th vx 0.5)))
(< (- (cadr vc) (* th vy 0.5))
(cadr p)
(+ (cadr vc) (* th vy 0.5))))
nil
T
)
)
(defun EntMakeLWPolyline (plist)
(entmake
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length plist))
)
(mapcar '(lambda (x) (cons 10 x)) plist)
)
)
)

(DEFUN C:PP   (/ oldEcho FirstPt ptlst NextPt)
   (setq oldEcho (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (setq FirstPt (GETPOINT "\nFirst point: "))
   (setq ptlst (list FirstPt))
   (while FirstPt
       (setq NextPt (getpoint FirstPt "\nNext point: "))
       (if NextPt
           (progn
               (if (ChkCloseToEdge NextPt 0.9)
                   (command "zoom" "c" NextPt ""))
               (setq ptlst (cons NextPt ptlst))
               (GrVecs (getvlist ptlst))
               )
           )
       (setq FirstPt NextPt)
       )
   (if (> (length ptlst) 1)
       (EntMakeLWPolyline ptlst)
       )
   (setvar "CMDECHO" oldEcho)
   (princ)
   )
;;;;;--------------------------
(defun getvlist   (lst / RetLst idx)
   (setq idx 0)
   (repeat (1- (length lst))
       (setq RetLst
                     (append
                         RetLst
                         (list (list (car (nth idx lst)) (cadr (nth idx lst))))
                         (list (list (car (nth (1+ idx) lst))
                                                 (cadr (nth (1+ idx) lst))))))
       (setq idx (1+ idx))
       )
   RetLst
   )
;;;
(defun ChkCloseToEdge   (p th / vc vx vy)
   (setq vc (getvar "VIEWCTR")
               vy (getvar "VIEWSIZE")
               vx (* vy
                           (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE")))))
   (if (and (< (- (car vc) (* th vx 0.5))
                           (car p)
                           (+ (car vc) (* th vx 0.5)))
                     (< (- (cadr vc) (* th vy 0.5))
                           (cadr p)
                           (+ (cadr vc) (* th vy 0.5))))
       nil
       T
       )
   )
(defun EntMakeLWPolyline   (plist)
   (entmake
       (append
           (list
               '(0 . "LWPOLYLINE")
               '(100 . "AcDbEntity")
               '(100 . "AcDbPolyline")
               (cons 90 (length plist))
               )
           (mapcar '(lambda (x) (cons 10 x)) plist)
           )
       )
   )

wolaikk · 发表于 2004-8-25 19:34:00

第二个好，用数组也没有错误了

小狼 · 发表于 2004-8-25 23:16:00

谢了,好多了,可惜还是不能回推,不过给了我很大的启发和思路，非常感谢

shift逸 · 发表于 2013-8-15 15:33:15

……支持支持，路过，学习。

香田里浪人 · 发表于 2013-9-1 16:15:57

感觉第二个不如第一个。

账号		自动登录	找回密码
密码			注册

[LISP]求助,一个画Pline线,并自动移屏的函数

浏览过的版块