zhaoboxuan 发表于 2016-6-14 20:25:41

关于图块接线，请大家帮忙，麻烦了!

本帖最后由 zhaoboxuan 于 2016-6-15 14:01 编辑

之前GU版主写了一版图块接线代码，现在需要改为"框选图块后，自左向自上之下、然后自下之上，每30个（可调）块为一组，接线方式按组分配"（已增加附图），麻烦各位版主大人，帮调整下，十分感谢(defun c:tt(/ os ss pl p1 p2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(setq ss (ssget '((0 . "insert"))))
(if ss
    (progn
      (setq pl (GXL-GETSSBOX ss)
            p1 (car pl)
            p2 (cadr pl)
            ss (GXL-SEL-SS->LIST ss)
            )
    ;;;此处画一个圆，图块投影到园上排序
      (command "_pline" p1 "a" "s" (list (car p1) (cadr p2)) p2 "s" (list (car p2) (cadr p1)) p1 "")
      (setq en (entlast))
      (setq ss (vl-sort ss '(lambda (a b)
                           (< (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf a 10)))
                              (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf b 10)))
                              )
                           )
                        )
            )
      (command "_pline")
      (mapcar 'command (mapcar '(lambda (X) (gxl-dxf x 10)) ss))
      (command "")
      (entdel en)
      )
    )
(setvar 'osmode os)
(princ)
)
;; gxl-GetssBox 取得选择集的实体外矩形框
(defun gxl-GetssBox      (ss / maxpt maxptlst minpt minptlst obj x ss1)
(setq ss1 (gxl-Sel-SS->List ss))
(foreach x ss1
    (setq obj (vlax-ename->vla-object x))
    ;(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    ;(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    (vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框
    (setq minPt (vlax-safearray->list minPt))
    (setq maxPt (vlax-safearray->list maxPt))
    (setq minPtlst (append minPtlst (list minPt)))
    (setq maxPtlst (append maxPtlst (list maxPt)))
) ;_ 结束foreach
(setq      minPt (list (apply 'min (mapcar 'car minPtlst))
                  (apply 'min (mapcar 'cadr minPtlst))
                  0
            ) ;_ 结束list
) ;_ 结束setq
(setq      maxPt (list (apply 'max (mapcar 'car maxPtlst))
                  (apply 'max (mapcar 'cadr maxPtlst))
                  0
            ) ;_ 结束list
) ;_ 结束setq
;(command "rectang" minPt maxPt)
(list minPt maxPt)
) ;_ 结束defun

(defun gxl-Sel-SS->List      (ss / i s )
    (if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
    )
    )
)
;;;==================================================================
;;;(gxl-dxf ent i )取出图元索引i对应的值
;;;==================================================================
(defun gxl-dxf (ent i)
    (cond ((= (type ent) 'ename)
            (cdr (assoc i (entget ent)))
             )
          ((= (type ent) 'list)
         (cdr (assoc i ent))
         )
    ) ;_ if
)


zhaoboxuan 发表于 2016-6-14 20:39:14

大侠们棒棒忙，这个对我非常重要，麻烦各位了
页: [1]
查看完整版本: 关于图块接线，请大家帮忙，麻烦了!