请教：如何重新指定一条封闭多段线的起点？（已解决，感谢andyhon）

mandala · 发表于 2011-3-13 22:48:47

本帖最后由 mandala 于 2011-3-15 20:59 编辑

在试着编写一个做宗地图的lisp，其它都解决了，剩下这个问题困扰了好久，请教一下各位前辈：

一条封闭多段线，比如一个梯形，先假设它必定是顺时针走向的（要设定走向不难），如何指定一个顶点，让其变为起点？如图：

mandala · 发表于 2011-3-13 22:51:22

本帖最后由 mandala 于 2011-3-13 22:59 编辑

先谢谢各位啦。

明经上有过类似的讨论，也有一些lisp贴出来，但我没找到可以让用户指定起点的lisp程序。

我只求一段lisp即可，错误处理什么的俺自己来，不麻烦各位，呵呵。

mandala · 发表于 2011-3-14 09:09:53

星期一顶起来。

xiaxiang · 发表于 2011-3-14 09:14:40

本帖最后由 xiaxiang 于 2011-3-14 09:52 编辑

回复 mandala 的帖子

1. http://bbs.mjtd.com/thread-44291-1-3.html
2.

;;点集按Pl起点到终点排序，返回(pline实体排序后的点表)
;;参数 pl --- pline 实体或Object，pts ---- 点集
;;其实 pl 可以是任何 Curve
(defun xdl-pts-sortonpl (pl pts)
(setq pts (mapcar
'(lambda (x)
(list (vlax-curve-getdistatpoint
pl
(vlax-curve-getclosestpointto pl x)
)
x
)
)
pts
)
pts (vl-sort pts
'(lambda (e1 e2)
(< (car e1) (car e2))
)
)
)
(list pl
(mapcar
'cadr
pts
)
)
)

3 http://bbs.mjtd.com/thread-51145-1-3.html

希望对楼主有所帮助

mandala · 发表于 2011-3-14 10:27:19

本帖最后由 mandala 于 2011-3-14 10:36 编辑

先谢谢楼上。不过我的问题还没有解决。

首先你提供的这个lsp不能指定pline的起点；其次你转的那个帖子里，那个lsp的作用只是重新标号，并没有改变pline本身的起点。最后那个拓扑的，我可能一下子用不上。

我希望达到的效果是指定一点后，能重新将pline重绘，以指定点为起点。

xiaxiang · 发表于 2011-3-14 10:39:57

回复 mandala 的帖子

如何指定一点？输入坐标吗？GETPOINT?

Andyhon · 发表于 2011-3-14 10:39:58

您试试这段代码
(setq dat (entget ee)    ;  LwPolyLine ee
ptfrst (cons 10 pt)    ; pt ==> 新起点 say '(100 200)
   dat0 (reverse (member '(39 . 0.0) (reverse dat)))
   dat1 (cdr (member '(39 . 0.0)  dat))
   dat9 (List (Last dat1))
   dat1 (reverse (cdr (reverse dat1)))
   data (member ptfrst dat1)
   datb (reverse (cdr (member ptfrst (reverse dat1))))
)
(entmod (append dat0 data datb dat9))

mandala · 发表于 2011-3-14 10:47:59

xiaxiang 发表于 2011-3-14 10:39
回复 mandala 的帖子

如何指定一点？输入坐标吗？GETPOINT?

嗯，我的想法是getpoint。

xiaxiang · 发表于 2011-3-14 11:51:39

回复 mandala 的帖子

先测试一个，还不能指定点。
可选择闭合与否。
绘制pline程序。
命令：CC

mandala · 发表于 2011-3-14 13:43:59

本帖最后由 mandala 于 2011-3-14 14:29 编辑

在实际作业时，画界址线的时候不会从1号点（通常在左上角）开始完整的画一条pline，如果不指定起点让界址线重画的话，我这个lisp的实用性不高。

贴上我写的画宗地图的lsp源码。如果能指定起点，那就完美喽！

;;制作宗地图，删除了错误处理程序。区域变量太多，这里就懒得标注了。
;;先依次以顺时针方向画好界址线，然后用make程序会自动标注点号、距离、加粗jzxout、圈上界址点并算出面积。
;;子程序暂时无用……等解决了指定起点的问题后再用。
;;需要引用字体“等线体”，随机用户可修改相应语句，用其它字体代替。
(DEFUN C:make ()
(SETVAR "CMDECHO" 0)
(COMMAND ".UNDO" "BE")
(SETQ OS (GETVAR "OSMODE")
ZIN (GETVAR "DIMZIN")
) ;_ 结束SETQ
(SETVAR "OSMODE" 0)
(SETVAR "DIMZIN" 0)
(PRINC "\n请选择已封闭的界址线: ")
(IF (setq pl (car (entsel)))
(PROGN (command "area" "o" pl)
(setq mj (getvar "area"))
; (if (= (fangxiang pl) 0) (reverseLwp pl))
;(setq startpoint (getpoint "\n请指定起点："))
(SETQ ent (entget pl))
(setq J 0
PLST (LIST)
) ;_ 结束setq
(REPEAT (LENGTH ENT)
(IF (= (CAR (NTH J ENT)) 10)
(SETQ PLST (APPEND PLST (LIST (CDR (NTH J ENT)))))
) ;_ 结束IF
(SETQ J (1+ J))
) ;_ 结束REPEAT
(SETQ J 0
LL (LENGTH PLST)
) ;_ 结束SETQ
(setq plename (vlax-ename->vla-object pl))
(if (vlax-curve-isClosed plename)
(setq ll ll)
(setq ll (- ll 1))
) ;_ 结束if
;;如果jzx不闭合（不是以“c”结束的），标注点号的循环数要少1
(REPEAT LL
(SETQ P (NTH J PLST))
(if (= j 0)
(setq plast (NTH (- ll 1) PLST))
(setq plast (NTH (- J 1) PLST))
) ;_ 结束if
(if (= j (- ll 1))
(setq pnext (NTH 0 PLST))
(setq pnext (NTH (1+ J) PLST))
) ;_ 结束if，以上两个if为下一步取得角平分线做准备
(setq pt1 (polar p (angle p plast) 1))
(setq pt2 (polar p (angle p pnext) 1))
(setq
pt3 (polar pt1 (angle pt1 pt2) (* 0.5 (distance PT1 PT2)))
;;以这种方式来求得角平分线，得到点位用以标注点号
) ;_ 结束setq
(setq P4 (POLAR P (ANGLE Pt3 p) 3))
(command "circle" p "0.4")
(setq n (rtos (1+ j) 2 0))
(command "text" "s" "等线体" "j" "c" p4 "2" "0" n)
(setq J (1+ J))
) ;_ 结束REPEAT
(command "_.explode" pl)
(setq ss1 (SSGET "P")
n 0
) ;_ 结束setq
(REPEAT ll
(setq jzx (ssname ss1 n))
(setq jzxename (vlax-ename->vla-object jzx))
(vla-offset jzxename 0.1)
(setq jzxout (entlast))
(command "chprop" jzxout "" "la" "jzxout" "")
(setq jzxout (entlast))
(setq jzxoutename (vlax-ename->vla-object jzxout))
(vla-offset jzxoutename -0.1)
(entdel jzxout)
(setq jzxout (entlast))
(if (= (cdr (assoc 0 (entget jzxout))) "ARC")
(setq d -2.5)
(setq d 2.5)
) ;_ 结束if，该段为下面标注距离时的注记位置做准备。绝大多数圆弧需要的d是负的。
(command "pedit" jzxout "y" "w" "0.3" "")
(setq jzxout (entlast))
;;以上偏移了每段jzx，变成jzxout后偏移回原位，变粗，得到对应的图元jzxout。
(setq jzxoutename (vlax-ename->vla-object jzxout))
(setq l (vlax-curve-getDistAtPoint
jzxoutename
(vlax-curve-getEndPoint jzxoutename)
) ;_ 结束vlax-curve-getDistAtPoint
) ;_ 结束setq
;;l为线长
(setq dist (rtos (/ l 2) 2 2))
(setq m (vlax-curve-getPointAtDist jzxoutename (/ l 2)))
;;m为中点
(setq angle1 (angle (vlax-curve-getstartPoint jzxoutename)
(vlax-curve-getendPoint jzxoutename)
) ;_ 结束angle
) ;_ 结束setq
;;angle1为距离注记的位置
(setq angle2 (/ (* angle1 180) pi))
;;angle2为注记旋转的角度,在某些情况下注记的旋转角度需要反转
(if (and (> angle2 90) (< angle2 270))
(setq angle2 (+ angle2 180))
) ;_ 结束if
;;以下的if分别考虑线长小于0.8和大于0.8两种情况下，jzxout的处理。
;;为了留出界址点位置，jzxout小于0.8，删除；大于0.8，截短。
(if (<= l 0.8)
(entdel jzxout)
(progn (setq start (vlax-curve-getStartPoint jzxoutename))
(setq end (vlax-curve-getendPoint jzxoutename))
(command "lengthen"
"de"
"-0.4"
(list jzxout start)
(list jzxout end)
""
) ;_ 结束command
) ;_ 结束progn
) ;_ 结束if
(command "text"
"s"
"等线体"
"j"
"m"
(polar m (+ angle1 (/ pi 2)) d)
"2"
angle2
dist
) ;_ 结束command
;;标注距离
(setq n (1+ n))
) ;_ 结束REPEAT
) ;_ 结束PROGN
) ;_ 结束IF
(SETVAR "OSMODE" OS)
(SETVAR "DIMZIN" ZIN)
(COMMAND ".UNDO" "E")
(prompt "\n搞定！")
(prompt "\n该区域面积 = ")
(princ (rtos mj 2 4))
(prompt " ")
(prompt "如果当前比例尺为1:500，那么实际面积= ")
(princ (rtos (/ mj 2) 2 4))
(PRINC)
) ;_ 结束DEFUN
;;;;;;;;;;;;;;;;
;;子程序，判断pline方向，返回1为顺时针，0为逆时针
(defun fangxiang (xx / fd ang offsetObj plineObj x fx)
(setq plineObj (vlax-ename->vla-object xx))
(setq fd (vlax-curve-getFirstDeriv plineObj 0.5))
(setq ang (atan (/ (cadr fd) (car fd))))
(setq offsetplineObj
(car
(vlax-safearray->list
(vlax-variant-value (vla-offset plineObj 0.0001)) ;_ 结束vlax-variant-value
) ;_ 结束vlax-safearray->list
) ;_ 结束car
) ;_ 结束setq
(if (> (vla-get-length plineobj)
(vla-get-length offsetplineobj)
) ;_ 结束>
(setq x 1)
(setq x 0)
) ;_ 结束if
(vla-delete offsetplineObj)
(setq fx x)
) ;_ 结束defun
;;;子程序：pline顶点逆序，disign by gu_xl
(defun reverseLwp (ent1 / a pl how li1 li2 li3)
(setq pl (entget ent1 '("*"))
how nil
) ;_ 结束setq
(foreach an pl
(if (setq a (member (car an) '(10 40 41 42)))
(setq how t)
) ;_ 结束if
(cond ((not how) (setq li1 (cons an li1)))
((and how a)
(cond ((= (car an) 40) (setq an (cons 41 (cdr an))))
((= (car an) 41) (setq an (cons 40 (cdr an))))
((= (car an) 42) (setq an (cons 42 (- 0 (cdr an)))))
(t an)
) ;_ 结束cond
(setq li2 (cons an li2))
)
((and how (not a)) (setq li3 (cons an li3)))
) ;_ 结束cond
) ;_ 结束foreach
(entmod
(append (reverse li1)
(append (cdddr li2) (list (car li2) (cadr li2) (caddr li2)))
(reverse li3)
) ;_ 结束append
) ;_ 结束entmod
) ;_ 结束defun

;;制作宗地图，删除了错误处理程序。区域变量太多，这里就懒得标注了。 
;;先依次以顺时针方向画好界址线，然后用make程序会自动标注点号、距离、加粗jzxout、圈上界址点并算出面积。 
;;子程序暂时无用……等解决了指定起点的问题后再用。 
;;需要引用字体“等线体”，随机用户可修改相应语句，用其它字体代替。 
 
 
(DEFUN C:make  () 
   (SETVAR "CMDECHO" 0) 
  (COMMAND ".UNDO" "BE") 
  (SETQ OS  (GETVAR "OSMODE") 
ZIN (GETVAR "DIMZIN") 
  ) ;_ 结束SETQ 
  (SETVAR "OSMODE" 0) 
  (SETVAR "DIMZIN" 0) 
    (PRINC "\n请选择已封闭的界址线: ") 
  (IF (setq pl (car (entsel))) 
    (PROGN (command "area" "o" pl) 
    (setq mj (getvar "area")) 
; (if (= (fangxiang pl) 0) (reverseLwp pl)) 
;(setq startpoint (getpoint "\n请指定起点：")) 
    (SETQ ent (entget pl)) 
    (setq J    0 
   PLST (LIST) 
    ) ;_ 结束setq 
    (REPEAT (LENGTH ENT) 
      (IF (= (CAR (NTH J ENT)) 10) 
        (SETQ PLST (APPEND PLST (LIST (CDR (NTH J ENT))))) 
      ) ;_ 结束IF 
      (SETQ J (1+ J)) 
    ) ;_ 结束REPEAT 
    (SETQ J  0 
   LL (LENGTH PLST) 
    ) ;_ 结束SETQ 
    (setq plename (vlax-ename->vla-object pl)) 
    (if (vlax-curve-isClosed plename) 
      (setq ll ll) 
      (setq ll (- ll 1)) 
    ) ;_ 结束if 
   ;;如果jzx不闭合（不是以“c”结束的），标注点号的循环数要少1 
    (REPEAT LL 
      (SETQ P (NTH J PLST)) 
      (if (= j 0) 
        (setq plast (NTH (- ll 1) PLST)) 
        (setq plast (NTH (- J 1) PLST)) 
      ) ;_ 结束if 
      (if (= j (- ll 1)) 
        (setq pnext (NTH 0 PLST)) 
        (setq pnext (NTH (1+ J) PLST)) 
      ) ;_ 结束if，以上两个if为下一步取得角平分线做准备 
      (setq pt1 (polar p (angle p plast) 1)) 
      (setq pt2 (polar p (angle p pnext) 1)) 
      (setq 
        pt3 (polar pt1 (angle pt1 pt2) (* 0.5 (distance PT1 PT2))) 
   ;;以这种方式来求得角平分线，得到点位用以标注点号 
      ) ;_ 结束setq 
      (setq P4 (POLAR P (ANGLE Pt3 p) 3)) 
      (command "circle" p "0.4") 
      (setq n (rtos (1+ j) 2 0)) 
      (command "text" "s" "等线体" "j" "c" p4 "2" "0" n) 
      (setq J (1+ J)) 
    ) ;_ 结束REPEAT 
    (command "_.explode" pl) 
    (setq ss1 (SSGET "P") 
   n   0 
    ) ;_ 结束setq 
    (REPEAT ll 
      (setq jzx (ssname ss1 n)) 
      (setq jzxename (vlax-ename->vla-object jzx)) 
      (vla-offset jzxename 0.1) 
      (setq jzxout (entlast)) 
      (command "chprop" jzxout "" "la" "jzxout" "") 
      (setq jzxout (entlast)) 
      (setq jzxoutename (vlax-ename->vla-object jzxout)) 
      (vla-offset jzxoutename -0.1) 
      (entdel jzxout) 
      (setq jzxout (entlast)) 
      (if (= (cdr (assoc 0 (entget jzxout))) "ARC") 
        (setq d -2.5) 
        (setq d 2.5) 
      ) ;_ 结束if，该段为下面标注距离时的注记位置做准备。绝大多数圆弧需要的d是负的。 
      (command "pedit" jzxout "y" "w" "0.3" "") 
      (setq jzxout (entlast)) 
      ;;以上偏移了每段jzx，变成jzxout后偏移回原位，变粗，得到对应的图元jzxout。 
      (setq jzxoutename (vlax-ename->vla-object jzxout)) 
      (setq l (vlax-curve-getDistAtPoint 
         jzxoutename 
         (vlax-curve-getEndPoint jzxoutename) 
       ) ;_ 结束vlax-curve-getDistAtPoint 
      ) ;_ 结束setq 
      ;;l为线长 
      (setq dist (rtos (/ l 2) 2 2)) 
      (setq m (vlax-curve-getPointAtDist jzxoutename (/ l 2))) 
      ;;m为中点 
      (setq angle1 (angle (vlax-curve-getstartPoint jzxoutename) 
     (vlax-curve-getendPoint jzxoutename) 
     ) ;_ 结束angle 
      ) ;_ 结束setq 
      ;;angle1为距离注记的位置 
      (setq angle2 (/ (* angle1 180) pi)) 
      ;;angle2为注记旋转的角度,在某些情况下注记的旋转角度需要反转 
      (if (and (> angle2 90) (< angle2 270)) 
        (setq angle2 (+ angle2 180)) 
      ) ;_ 结束if 
      ;;以下的if分别考虑线长小于0.8和大于0.8两种情况下，jzxout的处理。 
      ;;为了留出界址点位置，jzxout小于0.8，删除；大于0.8，截短。 
      (if (<= l 0.8) 
        (entdel jzxout) 
        (progn (setq start (vlax-curve-getStartPoint jzxoutename)) 
        (setq end (vlax-curve-getendPoint jzxoutename)) 
        (command "lengthen" 
          "de" 
          "-0.4" 
          (list jzxout start) 
          (list jzxout end) 
          "" 
        ) ;_ 结束command 
        ) ;_ 结束progn 
      ) ;_ 结束if 
        (command "text" 
        "s" 
        "等线体" 
        "j" 
        "m" 
        (polar m (+ angle1 (/ pi 2)) d) 
        "2" 
        angle2 
        dist 
      ) ;_ 结束command 
      ;;标注距离 
      (setq n (1+ n)) 
    ) ;_ 结束REPEAT 
    ) ;_ 结束PROGN 
  ) ;_ 结束IF 
  (SETVAR "OSMODE" OS) 
  (SETVAR "DIMZIN" ZIN) 
  (COMMAND ".UNDO" "E") 
  (prompt "\n搞定！") 
  (prompt "\n该区域面积 = ") 
  (princ (rtos mj 2 4)) 
  (prompt "  ") 
  (prompt "如果当前比例尺为1:500，那么实际面积= ") 
  (princ (rtos (/ mj 2) 2 4)) 
  (PRINC) 
) ;_ 结束DEFUN 
 
;;;;;;;;;;;;;;;; 
;;子程序，判断pline方向，返回1为顺时针，0为逆时针 
(defun fangxiang (xx / fd ang offsetObj plineObj x fx) 
  (setq plineObj (vlax-ename->vla-object xx)) 
  (setq fd (vlax-curve-getFirstDeriv plineObj 0.5)) 
  (setq ang (atan (/ (cadr fd) (car fd)))) 
  (setq offsetplineObj 
  (car 
    (vlax-safearray->list 
      (vlax-variant-value (vla-offset plineObj 0.0001)) ;_ 结束vlax-variant-value 
    ) ;_ 结束vlax-safearray->list 
  ) ;_ 结束car 
  ) ;_ 结束setq 
  (if (> (vla-get-length plineobj) 
  (vla-get-length offsetplineobj) 
      ) ;_ 结束> 
    (setq x 1) 
    (setq x 0) 
  ) ;_ 结束if 
  (vla-delete offsetplineObj) 
  (setq fx x) 
) ;_ 结束defun 
 
;;;子程序：pline顶点逆序，disign by gu_xl 
(defun reverseLwp (ent1 / a pl how li1 li2 li3) 
  (setq pl  (entget ent1 '("*")) 
how nil 
  ) ;_ 结束setq 
  (foreach an pl 
    (if (setq a (member (car an) '(10 40 41 42))) 
      (setq how t) 
    ) ;_ 结束if 
    (cond ((not how) (setq li1 (cons an li1))) 
   ((and how a) 
    (cond ((= (car an) 40) (setq an (cons 41 (cdr an)))) 
   ((= (car an) 41) (setq an (cons 40 (cdr an)))) 
   ((= (car an) 42) (setq an (cons 42 (- 0 (cdr an))))) 
   (t an) 
    ) ;_ 结束cond 
    (setq li2 (cons an li2)) 
   ) 
   ((and how (not a)) (setq li3 (cons an li3))) 
    ) ;_ 结束cond 
  ) ;_ 结束foreach 
  (entmod 
    (append (reverse li1) 
     (append (cdddr li2) (list (car li2) (cadr li2) (caddr li2))) 
     (reverse li3) 
    ) ;_ 结束append 
  ) ;_ 结束entmod 
) ;_ 结束defun

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

[基础] 请教：如何重新指定一条封闭多段线的起点？（已解决，感谢andyhon）

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源