Topic: Create a programe lisp as replace pedit function

[Adesu]

Hi Alls,
here my programe as replace pedit function, I got trouble to or in "lst" variable, because in command function, it want individual variable, any one have idea to solve this my code.
As you know pedit function have 7 steps for get a rectangular object, with this code I hope become more simple.

Code: [Select]

(defun c:test (/ ss j ssx lst)
  (if
    (setq ss (car (entsel "\nSelect an object line")))
    (progn
      (setq j "j")
      (while
(setq ssx (car (entsel "\nSelect alls object line")))
(setq lst (append lst (list ssx)))
)
      (command "_pedit" ss j
       (setq ent
      (if
lst
(progn
  (setq cnt 0)
  (setq len (length lst))
  (repeat
    len
    (setq ent (nth cnt lst))
    (setq cnt (1+ cnt))
    ) ; repeat
  (setq cnt nil len nil)
  )   ; progn
)     ; if
     )        ; setq
       "" "")
      )                       ; progn
    )                         ; if
  (princ)
  )                           ; defun


[VVA]

Try it
Simply select lines

Code: [Select]

(defun C:PL-JOIN ( / ssnab count en adoc)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-StartUndoMark adoc)
  (setq ssnab (ssget "_I"))
  (while (not ssnab)(setq ssnab (ssget)))
  (setq en (entlast) count 0)
  (if (> (sslength ssnab) 1)
  (if (and (getvar "PEDITACCEPT") (= (getvar "PEDITACCEPT") 1))
    (vl-cmdf "_pedit" "_Multiple" ssnab "" "_Join" 0 "")
    (vl-cmdf "_pedit" "_Multiple" ssnab "" "_Y" "_Join" 0 ""))
  )
  (while (and (setq en (entnext en))
      (= (cdr(assoc 0 (entget en))) "LWPOLYLINE"))
    (setq count (1+ count))
    )
(if (> count 0)
  (princ (strcat "\nÑreated "(itoa count)" LW polylines")))
  (setq ssnab nil)
  (vla-EndUndoMark adoc)
  (princ))


[VVA]

Or try it
It is necessary to choose object, and the command will join all adjoining objects (lines, polylines, arches...) in a polyline

Code: [Select]

;; pt - Point in WCS !!!
;;    - or ENAME or  VLA-OBJECT First entities
;; fuzz - fuzz distance
;;posted by VVA http://dwg.ru/forum/viewtopic.php?t=9627&postdays=0&postorder=asc&start=60
;;Return list of vla object
(defun ChainSelectFromAny ( pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
(vl-load-com)
(cond ((= (type pt) 'ENAME)
       (setq ln (vlax-ename->vla-object pt)
             pt nil))
      ((= (type pt) 'VLA-OBJECT)(setq ln pt pt nil))
      (t nil))
(if (setq ss (ssget "_I") ss nil
          ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE")))) ;_ end of setq
  (progn
    (if pt (progn
      (setq ln1 (vla-addLine
            (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
                     (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object))))) ;_ end of and
                      (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
                      (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
               (vlax-3d-point pt)(vlax-3d-point (mapcar '- pt '(1 1 0)))))
        (setq ln ln1)))
     (setq spt (vlax-curve-getStartPoint ln)  ept (vlax-curve-getEndPoint ln))
    (setq line_list  (mapcar 'vlax-ename->vla-object
                             (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                     ) ;_ end of mapcar
          chain_list nil
          chain_list (cons ln chain_list)) ;_ end of setq
    (setq line_list (vl-remove-if
                      '(lambda (x)(eq "AcDb3dPolyline" (vla-get-objectname x)))
                      line_list)) ;_ end of setq
    (setq loop t cycl 0)
    (while loop
     (while
        (setq couple
               (vl-remove-if-not
                 (function (lambda (x)
                             (or (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz      ;<--- äîïóñê
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getStartPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- äîïóñê
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getStartPoint ln)
                                        fuzz     ;<--- äîïóñê
                                 ) ;_ end of equal
                                 (equal (vlax-curve-getEndPoint x)
                                        (vlax-curve-getEndPoint ln)
                                        fuzz     ;<--- äîïóñê
                                 ) ;_ end of equal
                             ) ;_ end of or
                           ) ;_ end of lambda
                 ) ;_ end of function
                 line_list
               ) ;_ end of vl-remove-if-not
        ) ;_ end of setq
       (grtext -1 (strcat "Working. Step - " (itoa (setq cycl (1+ cycl)))))
         (if couple (progn
             (setq chain_list (append couple chain_list))
             (setq line_list (vl-remove ln line_list))
             (setq ln (car chain_list))) ;_ end of progn
           (setq line_list (cdr line_list))) ;_ end of if
      ) ;_ end of while
      (setq loop nil)
    ) ;_ end of while
  ) ;_ end of progn
) ;_ end of if
  (setq chain_list (vl-remove ln1 chain_list))
  (if (= (type ln1) 'VLA-OBJECT)(vl-catch-all-apply 'vla-erase (list ln1)))
  (vl-cmdf "_.redraw") chain_list)

;;;* Mark data base to allow KB:catch.
;;;* http://www.theswamp.org/index.php?topic=15863.0
(defun mip:mark (/ val)
 (setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
   (if (setq *mip:mark (entlast)) nil
      (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
             (setq *mip:mark (entlast))
             (entdel *mip:mark)))
   (setvar "cmdecho" val)(princ))
(defun mip:get-last-ss (/ ss tmp val)
(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
(if *mip:mark (progn (setq ss (ssadd))
 (while (setq *mip:mark (entnext *mip:mark))(ssadd *mip:mark ss))
 (command "._select" ss "")(setq tmp ss ss nil));_progn
 (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss."));_if
 (setvar "cmdecho" val) tmp)
(defun C:CSS ( / ss pda en fuzz val)
 (vl-load-com)(setq val (getvar "cmdecho"))(setvar "cmdecho" 0)
 (if (and (setq en (car(entsel "\n Ñhoose first or last line in a chain :")))
          (wcmatch (cdr(assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
          (setq en (vlax-ename->vla-object en))
          (/= "AcDb3dPolyline" (vla-get-objectname en))
          )
 (progn
 (if (null (setq fuzz (getdist "\nFuzz distance < 0 >: ")))(setq fuzz 0))
 (setq ss (ssadd))
 (foreach item (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
      (ssadd (vlax-vla-object->ename item) ss))
  (mip:mark)
  (vl-catch-all-apply '(lambda()
  (if (setq pda (getvar "PEDITACCEPT"))(progn
    (setq pda (getvar "peditaccept"))
    (setvar "peditaccept" 1)
    (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    (setvar "peditaccept" pda))
    (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz ""))))
   (setq lst (vl-remove-if 'vlax-erased-p lst))
  (if (setq ss nil ss (mip:get-last-ss))(progn
      (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
      (setq fuzz 0)
      (while (setq en (ssname ss fuzz))
        (if (/= (cdr(assoc 0 (entget en))) "LWPOLYLINE")
          (ssdel en ss)
          (setq fuzz (1+ fuzz))))
      (sssetfirst ss ss)))
  (setq ss nil)
  )
   (princ "\nIt is necessary to choose the LINE, ARC or Polyline")
   )
(setvar "cmdecho" val)(princ)
)
(princ "\nType CSS in command lin")



[Adesu]

Hi VVA,
it's great code.
thanks very much for your help.