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

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

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

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: "))
       (ifNextPt
         (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.在每次输入点位的时候，都进行从新定位，速度很慢，特别是带有影象的时候<BR>2.没有回推，和闭合选项，画线工具不完美


建议:


1.根据屏幕高度和当前点位的一定比例(比如当前点位到了屏幕上方多少,移屏),将当前屏幕中点移至当前点位.


2.用Entmod生成实体速度比较快

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

提的好啊

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

I suggest you usethe 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)
         )
       )
   )

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

感觉第二个不如第一个。
页: [1]
查看完整版本: [LISP]求助,一个画Pline线,并自动移屏的函数