【Gu_xl】基于方位角计算的拓扑多边形自动构建快速算法

snigefqb

chshsl 发表于 2017-8-9 11:01
经过2天的研究G大侠的代码及网盘函数库，复原了，所缺的几个函数，见大家都希望补全，现贴上。希望G大侠不 ...

error: no function definition: GXL-SEL-SS->LIST; 出错后重置,请问这个又是什么

chshsl

;;;根据线段图元表构建二维坐标表'((首端点 末端点)  ...)
(defun gxl-ent->Coordinates1 (enLst)
  (mapcar '(lambda (x)
     (list (list (car (setq a (vlax-curve-getStartPoint x))) (cadr a))
   (list (car (setq a (vlax-curve-getendPoint x))) (cadr a))
     ) ;_ list
   ) ;_ lambda
  enlst
  ) ;_ mapcar
) ;_ defun

;;;gxl-Sel-EntNextAll en 返回 en 之后的所有物体选择集，无则返回 nil
(defun gxl-Sel-EntNextAll (ent / ss ent1)
(setq ss (ssadd))
(while (setq ent1 (entnext ent))
(ssadd ent1 ss)
(setq ent ent1)
)
(if (= 0 (sslength ss))
nil
ss
)
)
;;;选择集转为图元列表
(defun gxl-Sel-SS->List (ss / cs_i out)
(if (= (type ss) 'PICKSET)
(progn
(setq cs_i 0.0
out '()
)
(repeat (sslength ss)
(setq out (cons (ssname ss cs_i) out))
(setq cs_i (1+ cs_i))
)
(setq out (reverse out))
)
)
)

;;图元列表转为选择集
(defun gxl-Sel-List->SS (Lst / en ss)  
(setq ss (ssadd)
kk 0)
(foreach en Lst
(ssadd en ss)
(setq kk (1+ kk))
)
ss
)

chshsl

;;;==================================================================
;;;(gxl-dxf ent i )取出图元索引i对应的值
;;;==================================================================
(defun gxl-dxf (ent i)
(if (= (type ent) 'ename)
(setq ent (entget ent))
)
(cdr (assoc i ent))

)
;;;==================================================================
;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
;;;==================================================================
(defun gxl-CH_Ent (ent i pt / en)
(if (assoc i (setq en (entget ent)))
(setq en (subst (cons i pt) (assoc i en) en))
(setq en (append en (list (cons i pt))))
)
(entmod en)
)
;;删除表中第N个元素

(defun gxl-removeNth (index lst / c rtn lst1)
  (if (>= index  (length lst)) ;_ index 越界
    lst
  (if (< index (/ (length lst) 2)) ;_ index位于前半截
    (progn
  (setq c -1 lst1 lst)
  (vl-some '(lambda (x) (if (equal index (setq c (1+ c))) t (progn (setq rtn (cons x rtn) lst1 (cdr lst1)) nil))) lst)
  (append (reverse rtn) (cdr lst1))
  )
    (progn ;_ index位于后半截
      (setq index (- (length lst) index 1) lst (reverse lst))
        (setq c -1 lst1 lst)
  (vl-some '(lambda (x) (if (equal index (setq c (1+ c))) t (progn (setq rtn (cons x rtn) lst1 (cdr lst1)) nil))) lst)
  (reverse (append (reverse rtn) (cdr lst1)))
      )
    )
    )
)


(defun gxl-massoc( d li /  a  ls )
        (setq ls '())
        (while (assoc d li)
                (progn
                        (setq  a (assoc d li))
                        (setq ls (cons (list (cadr a) (caddr a)) ls))
                        (setq li (xdlsp_list_remove li  a))
                )
        )
        (reverse ls)
)

;输出50个空格
;(gxl-Str-Space 50) "                                                  "
;(gxl-Str-Space -1)
(defun gxl-Str-Space ( d  /  a )
    (setq a "")
        (if (>  d 0)
                (repeat d
                  (setq a (strcat a " " ))
                 )
        )
        a
)

;删除表中重复项
(defun gxl-ListDumpAtom( l1 /  l2)
(while(setq l2(cons(car l1)l2) l1(vl-remove(car l1)(cdr l1))))
(reverse l2)
)

;; 曲线一点的切线方向的角度
;;示例(HH:PtFirstAngle (car (entsel)) (getpoint))
(defun gxl-GetCurveTangent (obj pt)
  (setq param (vlax-curve-getParamAtPoint obj pt))
  (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv obj param)))
)
;;常用变量
(setq
      pi2           (* pi 0.5)
      pi4           (* pi 0.25)
      2pi           (* pi 2.)
      3pi2           (* 1.5 pi)
      3pi4   (+ pi2 pi4)
      5pi4   (+ pi pi4)
      7pi4 (+ 3pi2 pi4)
      #ZJWS# 2
      *jd* 0.00001
)

这次应该是齐了，因为我这里运行已经没问题了。

qq84603709

迟滞~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

zfcdage

thanksgiving

一张单程票

; 错误: no function definition: SETUNDOERR，提示这个，

bluefcc1

值得下載學習!

zazhz123

太厉害了，换个镂空

cn0yahoo

这个程序好复杂啊，新手只好先保留备学

ssyfeng

学习研究下拓扑。。