Author Topic: help modifying a lisp routine (Read 2153 times)

HasanCAD · « **on:** March 11, 2015, 03:27:12 AM »

Hi all
- This code always ignore one rectangle.

- How to add UNDO.

Code - Auto/Visual Lisp: [Select]

(defun c:ColumnSsiZes () (c:CSZ))
(defun c:CSZ ( /  )
  (vl-load-com)
  (_makefonts '(("SDC-TEXT" . "Arial.ttf")))
  (setq plinecnt 0)
  (setq Mcnvrt 0.1)
  (setq i -1)
   
  (if (and
        (princ "\nSelect Objects")
        (setq p1 (getpoint))
        (setq p2 (getcorner p1 "\nSelect Objects"))
        )
    (progn
      (command "_.zoom" p1 p2)
      (setq ssPL (ssget "_C" p1 p2  (list (cons 0 "POLYLINE"))))
      (if sspl
        (progn
          (while (setq ent (ssname sspl (setq i (1+ i))))
            (command "_.convertpoly" "l" ent "")
            (entupd ent)
            )
          )
        )
      (setq ss (ssget "_C" p1 p2  (list (cons 0 "ARC,*LINE"))))
      (if ss
        (progn
          (command "_.explode" SS)
          (setq peditaccept (getvar 'peditaccept))
          (setvar 'peditaccept 1)
          (ssget "_C" p1 p2  (list (cons 0 "ARC,*LINE")))
          (command "_.pedit" "_M" ss "" "_J" "" "")
          (setvar 'peditaccept peditaccept)
          ))
      (setq ss (ssget "_C" p1 p2))
      (if ss
        (repeat (sslength ss)
          (setq PlineOb (ssname ss plinecnt))
          (setq PlineObj (vlax-ename->vla-object PlineOb))
          (if (= (cdr (assoc 0 (entget PlineOb))) "LWPOLYLINE")
            (progn
              (if (< 4 (cdr (assoc 90 (entget PlineOb))))
              (progn
                (PSimple PlineObj)
                (setq PlineObget (entget PlineOb))
                (if (< 4 (cdr (assoc 90 PlineObget)))
                  (DimPL PlineOb)
                  ) ;if
                ) ; progn
              ) ;if
            (setq PlineObget (entget PlineOb))
            (if (< 2 (cdr (assoc 90 PlineObget)))
                (progn
                  (vla-getboundingbox PlineObj 'mn 'mx)
                  (setq mn (vlax-safearray->list mn))
                  (setq mx (vlax-safearray->list mx))
                  (setq pntnX (nth 0 mn))  (setq pntnY (nth 1 mn))
                  (setq pntxX (nth 0 mx))  (setq pntxY (nth 1 mx))
                  (InsText (strcat " " (rtos (* Mcnvrt (- pntxX pntnX)) 2 0) " x " (rtos (* Mcnvrt (- pntxY pntnY)) 2 0)) (list pntxX pntnY 0.0) T )
                  ) ; progn
                ) ;if
              ) ;progn
              ) ;if
          (if (= (vla-get-ObjectName PlineObj) "AcDbCircle")
            (progn
              (setq CrclRds  (vla-get-Radius PlineObj))
              (setq CrclCntr (vlax-safearray->list (vlax-variant-value (vla-get-Center PlineObj))))
              (InsText (strcat " D= " (rtos (* 2 Mcnvrt CrclRds) 2 0)) CrclCntr T)
              ) ;progn
            ) ; if
          (setq plinecnt (1+ plinecnt))
          ) ;repeat
        (princ "\nNo lines to get Distance")
        ); if
      ) ;progn
    (princ "\nNo lines to get Distance")
    ) ; if
  (command "_.zoom" "_p")
  (setvar "osmode" 0)
  (princ)
  ) ;defun
    
(princ)
(princ "\n      q_|_|| _\\|| q_|| _\\|"         )
(princ "\n  Type  CSZ  to invoke the lisp "     )
 
;;local error handler
(defun *error* (msg)
  (if (member msg '("console break" "Function cancelled"))
      (princ)
      (princ (strcat "\nError " (itoa (getvar "ERRNO")) ": " msg))
  );if
;;restore old error handler
  (setvar "osmode" 0)
  (setq *error* olderr olderr nil)
  
  (princ)
);*lerror*
 
(defun InsText ( strng pt an / )
  (entmakex
    (list
      (cons 0  "TEXT")
      (cons 7 "SDC-TEXT")
      (cons 1  strng)
      (cons 10 Pt)
      (cons 40 250)
      (cons 41 0.75)
    )
  )
  (if an (vl-cmdf "CHPROP" "L" "" "Annotative" "Yes" ""))
)
 
 
;;by VovKa  http://www.theswamp.org/index.php?to...4927#msg384927
(defun _makefonts (listoffonts / doc font fntdir st)            ;; Usage (_makefonts '(("SDC-TEXT" . "Arial.ttf")))
  (vl-load-com)
  (setq doc    (vla-get-activedocument (vlax-get-acad-object))
        fntdir (strcat (getenv "windir") "\\Fonts\\"))
  (foreach f listoffonts
    (cond ((or (setq font (findfile (cdr f)))
               (and (setq font (findfile (strcat fntdir (cdr f)))) (findfile font)))
           (setq st (vla-add (vla-get-textstyles doc) (car f)))
           (vlax-put-property st 'fontfile font)
           (vlax-put-property st 'width 1.0)
           (vlax-put-property st 'height 0.0)
           )))
  (princ))
; END DEFUN - _makefonts
 
; DimPL - Function to dimension Polyline
; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
; Arguments: 1
;   EntName^ = Polyline entity name
; Returns: Dimensions Polyline
 
(defun DimPL (EntName^ / Bottom@ Clayer$ CW# DiffAng DimPts: DimSpace~ EntList@
  Item LastAng~ LastPt Left@ List@ NW@ Osmode# P0 P1 P2 Pt Pts@ PtsLen Right@ SE@
  Top@ X~ X1~ X1Y1 X1Y2 X1Ys@ X2~ X2Y1 X2Y2 X2Ys@ XPts@ Y~ Y1~ Y1X1 Y1X2 Y1Xs@ Y2~
  Y2X1 Y2X2 Y2Xs@ YPts@)
  
  (defun DimPts: (Pts@ StartPt EndPt Type$ / Add Num1~ Num2~ Nums1@ Nums2@ P1 P2
    Pt Return@)
    (setq Add t)
    (foreach Pt (member StartPt (append Pts@ Pts@))
      (if Add
        (setq Return@ (append Return@ (list Pt)))
      );if
      (if (equal Pt EndPt)
        (setq Add nil)
      );if
    );foreach
    (foreach Pt Return@
      (if (member Type$ (list "Left" "Right"))
        (setq Nums1@ (append Nums1@ (list (cadr Pt))))
        (setq Nums1@ (append Nums1@ (list (car Pt))))
      );if
    );foreach
    (foreach Num1~ (vl-sort Nums1@ '<)
      (setq Nums2@ nil)
      (foreach Pt Return@
        (if (member Type$ (list "Left" "Right"))
          (if (= (cadr Pt) Num1~)
            (setq Nums2@ (append Nums2@ (list (car Pt))))
          );if
          (if (= (car Pt) Num1~)
            (setq Nums2@ (append Nums2@ (list (cadr Pt))))
          );if
        );if
      );foreach
      (if (member Type$ (list "Left" "Bottom"))
        (setq Nums2@ (vl-sort Nums2@ '<))
        (setq Nums2@ (reverse (vl-sort Nums2@ '<)))
      );if
      (foreach Num2~ (cdr Nums2@)
        (if (member Type$ (list "Left" "Right"))
          (setq Pt (list Num2~ Num1~))
          (setq Pt (list Num1~ Num2~))
        );if
        (setq Return@ (vl-remove Pt Return@))
      );foreach
    );foreach
    (cond
      ((= Type$ "Left")
        (vl-sort Return@ (function (lambda (P1 P2)(< (cadr P1)(cadr P2)))))
      );case
      ((= Type$ "Top")
        (vl-sort Return@ (function (lambda (P1 P2)(< (car P1)(car P2)))))
      );case
      ((= Type$ "Right")
        (vl-sort Return@ (function (lambda (P1 P2)(> (cadr P1)(cadr P2)))))
      );case
      ((= Type$ "Bottom")
        (vl-sort Return@ (function (lambda (P1 P2)(> (car P1)(car P2)))))
      );case
    );cond
  );defun DimPts:
 
  (setq EntList@ (entget EntName^))
  (if (= (cdr (assoc 0 EntList@)) "LWPOLYLINE")
    (progn
      (foreach List@ EntList@
        (if (= (car List@) 10)
          (if (not (equal (cdr List@) LastPt))
            (progn
              (setq Pts@ (append Pts@ (list (cdr List@))))
              (if (> (length Pts@) 2)
                (if (/= (angle LastPt (cdr List@)) LastAng~) (setq DiffAng t))
              );if
              (if (> (length Pts@) 1)
                (setq LastAng~ (angle LastPt (cdr List@)))
              );if
              (setq LastPt (cdr List@))
            );progn
          );if
        );if
      );foreach
      (if (equal (car Pts@) (last Pts@))
        (setq Pts@ (reverse (cdr (reverse Pts@))))
      );if
      (setq PtsLen (length Pts@))
    );progn
    (exit)
  );if
  (foreach Pt Pts@
    (setq X~ (atof (rtos (car Pt) 2 8))
          Y~ (atof (rtos (cadr Pt) 2 8))
          XPts@ (append XPts@ (list X~))
          YPts@ (append YPts@ (list Y~))
          Pts@ (cdr (append Pts@ (list (list X~ Y~))))
    );setq
  );foreach
  (setq XPts@ (vl-sort XPts@ '<)
        YPts@ (vl-sort YPts@ '<)
        X1~ (car XPts@)
        X2~ (last XPts@)
        Y1~ (car YPts@)
        Y2~ (last YPts@)
  );if
  (foreach Pt Pts@
    (if (= (car Pt) X1~) (setq X1Ys@ (append X1Ys@ (list (cadr Pt)))))
    (if (= (car Pt) X2~) (setq X2Ys@ (append X2Ys@ (list (cadr Pt)))))
    (if (= (cadr Pt) Y1~) (setq Y1Xs@ (append Y1Xs@ (list (car Pt)))))
    (if (= (cadr Pt) Y2~) (setq Y2Xs@ (append Y2Xs@ (list (car Pt)))))
  );foreach
  (setq X1Ys@ (vl-sort X1Ys@ '<)
        X2Ys@ (vl-sort X2Ys@ '<)
        Y1Xs@ (vl-sort Y1Xs@ '<)
        Y2Xs@ (vl-sort Y2Xs@ '<)
        X1Y1 (list X1~ (car X1Ys@))
        X1Y2 (list X1~ (last X1Ys@))
        X2Y1 (list X2~ (car X2Ys@))
        X2Y2 (list X2~ (last X2Ys@))
        Y1X1 (list (car Y1Xs@) Y1~)
        Y1X2 (list (last Y1Xs@) Y1~)
        Y2X1 (list (car Y2Xs@) Y2~)
        Y2X2 (list (last Y2Xs@) Y2~)
        Pts@ (member X1Y1 (append Pts@ Pts@))
  );setq
  (while (> (length Pts@) PtsLen)
    (setq Pts@ (reverse (cdr (reverse Pts@))))
  );while
  (setq SE@ (member X2Y2 Pts@) NW@ Pts@)
  (foreach Item SE@
    (setq NW@ (vl-remove Item NW@))
  );foreach
  (setq SE@ (append SE@ (list X1Y1))
        NW@ (append NW@ (list X2Y2))
        CW# 0
  );setq
  (foreach Pt (list Y2X1 Y2X2)
    (if (member Pt NW@) (setq CW# (1+ CW#)))
    (if (member Pt SE@) (setq CW# (1- CW#)))
  );foreach
  (foreach Pt (list Y1X1 Y1X2)
    (if (member Pt SE@) (setq CW# (1+ CW#)))
    (if (member Pt NW@) (setq CW# (1- CW#)))
  );foreach
  (if (< CW# 0)
    (setq Pts@ (append (list (car Pts@))(reverse (cdr Pts@))))
  );if
  (setq Left@ (DimPts: Pts@ Y1X1 Y2X1 "Left"))
  (setq Top@ (DimPts: Pts@ X1Y2 X2Y2 "Top"))
  (setq Right@ (DimPts: Pts@ Y2X2 Y1X2 "Right"))
  (setq Bottom@ (DimPts: Pts@ X2Y1 X1Y1 "Bottom"))
  
  (command "UNDO" "BEGIN")
  (setq DimSpace~ 500)
  (setq Osmode# (getvar "OSMODE")) (setvar "OSMODE" 0)
  (setq Clayer$ (getvar "CLAYER"))
  (command "LAYER" "S" (GetDimLayer) "");<--Change to your Dim layer info
  (setq P0 (polar X1Y1 pi (* DimSpace~ 1.5))
        P1 (car Left@)
  );setq
  (foreach P2 (cdr Left@)
    (command "DIM1" "VER" P1 P2 P0 "")
    (setq P1 P2)
  );foreach
  (if (> (length Left@) 2)
    (progn
      (setq P0 (polar P0 pi DimSpace~))
      (command "DIM1" "VER" (car Left@) (last Left@) P0 "")
    );progn
  );if
  (setq P0 (polar Y2X1 (* pi 0.5) (* DimSpace~ 1.5))
        P1 (car Top@)
  );setq
  (foreach P2 (cdr Top@)
    (command "DIM1" "HOR" P1 P2 P0 "")
    (setq P1 P2)
  );foreach
  (if (> (length Top@) 2)
    (progn
      (setq P0 (polar P0 (* pi 0.5) DimSpace~))
      (command "DIM1" "HOR" (car Top@) (last Top@) P0 "")
    );progn
  );if
  (setq P0 (polar X2Y2 0 (* DimSpace~ 1.5))
        P1 (car Right@)
  );setq
  (if (and (> (length Right@) 2) DiffAng)
    (foreach P2 (cdr Right@)
      (command "DIM1" "VER" P1 P2 P0 "")
      (setq P1 P2)
    );foreach
  );if
  (setq P0 (polar Y1X2 (* pi 1.5) (* DimSpace~ 1.5))
        P1 (car Bottom@)
  );setq
  (if (and (> (length Bottom@) 2) DiffAng)
    (foreach P2 (cdr Bottom@)
      (command "DIM1" "HOR" P1 P2 P0 "")
      (setq P1 P2)
    );foreach
  );if
  (setvar "CLAYER" Clayer$)
  (setvar "OSMODE" Osmode#)
  (command "UNDO" "END")
  (princ)
);defun DimPL
 
;-------------------------------------------------------------------------------
; GetDimLayer - Returns the layer name that's on and has the most dimensions,
; or the current layer name if there's no dimensions.
;-------------------------------------------------------------------------------
(defun GetDimLayer (/ DimLayer$ EntList@ Index# Layer$ LayerInfo@ LayerList@ List@ Num# SS&)
  (setq Layer$ (getvar "CLAYER"))
  (if (setq SS& (ssget "X" '((0 . "DIMENSION"))))
    (progn
      (setq Index# -1)
      (while (< (setq Index# (1+ Index#)) (sslength SS&))
        (setq EntList@ (entget (ssname SS& Index#))
              DimLayer$ (cdr (assoc 8 EntList@))
              LayerInfo@ (tblsearch "LAYER" DimLayer$)
        );setq
        (if (and (= (cdr (assoc 70 LayerInfo@)) 0)(> (cdr (assoc 62 LayerInfo@)) 0))
          (if (assoc DimLayer$ LayerList@)
            (setq Num# (1+ (cdr (assoc DimLayer$ LayerList@)))
                  LayerList@ (subst (cons DimLayer$ Num#) (assoc DimLayer$ LayerList@) LayerList@)
            );setq
            (setq LayerList@ (append LayerList@ (list (cons DimLayer$ 1))))
          );if
        );if
      );while
      (if LayerList@
        (progn
          (setq Layer$ (car (car LayerList@))
                Num# (cdr (car LayerList@))
          );setq
          (foreach List@ (cdr LayerList@)
            (if (> (cdr List@) Num#)
              (setq Layer$ (car List@)
                    Num# (cdr List@)
              );setq
            );if
          );foreach
        );progn
      );if
    );progn
  );if
  Layer$
);defun GetDimLayer
(princ);End of DPL.lsp
 
 
  ;;;=======================[ PSimple.lsp ]======================= 
  ;;; Author: Charles Alan Butler 
  ;;; Version:  1.7 Nov. 23, 2007
  ;;; Purpose: To remove unnecessary vertex from a pline
  ;;; Supports arcs and varying widths
  ;;;=============================================================
  ;; This version will remove the first vertex if it is colinear
  ;; and first & last arcs that have the same center
  ;; Open plines that have the same start & end point will be closed
 
  ;;  Argument: et
  ;;    may be an ename, Vla-Object, list of enames or
  ;;    a selection set
  ;;  Returns: a list, (ename message)
  ;;    Massage is number of vertex removed or error message string
  ;;    If a list or selection set a list of lists is returned
 
  (defun PSimple ( et / doc result Tan Replace BulgeCenter RemoveNlst ps1 )
 
    (vl-load-com)
 
    (defun tan ( a ) (/ (sin a) (cos a)))
 
    (defun replace ( lst in itm )
      (setq in (1+ in))
      (mapcar '(lambda (x) (if (zerop (setq in (1- in))) itm x)) lst)
    )
 
    ;;  CAB 11.16.07
    ;;  Remove based on pointer list
    (defun RemoveNlst ( nlst lst )
      (setq in -1)
      (vl-remove-if '(lambda (x) (not (null (vl-position (setq in (1+ in)) nlst)))) lst)
    )
    
    (defun BulgeCenter ( bulge p1 p2 / delta chord radius center )
      (setq delta  (* (atan bulge) 4)
            chord  (distance p1 p2)
            radius (/ chord (sin (/ delta 2)) 2)
            center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
      )
    )
 
    ;;  Main function to remove vertex
    ;;  ent must be an ename of a LWPolyline
    (defun ps1 ( ent /      aa     cpt    dir    doc    elst   hlst   Remove
                     idx    keep   len    newb   result vlst   x      closed
                     d10    d40    d41    d42    hlst   p1     p2     p3
                     plast  msg )
        
        (setq elst (entget ent)
              msg  "")
        (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
        (if (> (length d10) 2)
          (progn
            ;;  seperate vertex data
            (setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst))
            (setq d41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst))
            (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
            ;;  remove extra vertex from point list
            (setq plast (1- (length d10)))
            (setq p1 0  p2 1  p3 2)
            (if (and (not (setq closed (vlax-curve-isclosed ent)))
                     (equal (car d10) (last d10) 1e-6))
              (progn
                (setq Closed t ; close the pline
                      elst (subst (cons 70 (1+(cdr(assoc 70 elst))))(assoc 70 elst) elst)
                      msg  " Closed and")
                (if (and (not(zerop (nth plast d42)))(not(zerop (nth 0 d42))))
                  (setq d10 (reverse(cdr(reverse d10)))
                        d40 (reverse(cdr(reverse d40)))
                        d41 (reverse(cdr(reverse d41)))
                        d42 (reverse(cdr(reverse d42)))
                        plast (1- plast)
                  )
                )
              )
            )
            (setq idx -1)
            (while (<= (setq idx (1+ idx)) (if closed (+ plast 2) (- plast 2)))
              (cond
                ((and (or (equal (angle (nth p1 d10) (nth p2 d10))
                                 (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                          (equal (nth p1 d10) (nth p2 d10) 1e-6)
                          (equal (nth p2 d10) (nth p3 d10) 1e-6))
                      (zerop (nth p2 d42))
                      (or (= p1 plast)
                          (zerop (nth p1 d42)))
                 )
                 (setq remove (cons p2 remove)) ; build a pointer list
                 (setq p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
                ((and (not (zerop (nth p2 d42)))
                      (or closed (/= p1 plast))
                      (not (zerop (nth p1 d42))) ; got two arcs
                      (equal
                        (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                        (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                        1e-4)
                 )
                 ;;  combine the arcs
                 (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                       newb (tan (/ aa 4.0))
                 )
                 (if (minusp (nth p1 d42))
                   (setq newb (- (abs newb)))
                   (setq newb (abs newb))
                 )
                 (setq remove (cons p2 remove)) ; build a pointer list
                 (setq d42 (replace d42 p1 newb))
                 (setq p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
                (t
                 (setq p1 p2
                       p2 (if (= p2 plast) 0 (1+ p2))
                       p3 (if (= p3 plast) 0 (1+ p3))
                 )
                )
              )
            )
            (if remove
              (progn
                (setq count (length d10))
                ;; Rebuild the vertex data with pt, start & end width, bulge
                (setq d10 (RemoveNlst remove d10)
                      d40 (RemoveNlst remove d40)
                      d41 (RemoveNlst remove d41)
                      d42 (RemoveNlst remove d42)
                )
                (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                          x  y
                                          (cons 42 z))) d10 d40 d41 d42)
                )
                ;;  rebuild the entity data with new vertex data
                (setq hlst (vl-remove-if
                             '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
                )
                (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
                (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
                (if (entmod hlst); return ename and number of vertex removed
                  (list ent (strcat msg " Vertex removed " (itoa(- count (length d10)))))
                  (list ent " Error, may be on locked layer.")
                )
              )
              (list ent "Nothing to remove - no colenier vertex.")
            )
          )
          (list ent "Nothing to do - Only two vertex.")
        )
    )
    
 
    ;;  ========  S T A R T   H E R E  ===========
    (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    (cond
      ((or (=(type et) 'ENAME)
           (and (=(type et) 'VLA-object)
                (setq et (vlax-vla-object->ename et))))
        (vla-startundomark doc)
        (setq result (ps1 et))
        (vla-endundomark doc)
       )
      ((= (type et) 'PICKSET)
        (vla-startundomark doc)
        (setq result (mapcar '(lambda(x) (ps1 x))
                (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
        (vla-endundomark doc)
      )
      ((listp et)
        (vla-startundomark doc)
        (setq result (mapcar '(lambda(x) (ps1 x)) et))
        (vla-endundomark doc)
      )
      ((setq result "PSimple Error - Wrong Data Type."))
    )
    result
  )

roy_043 · « **Reply #1 on:** March 11, 2015, 04:16:02 AM »

This is a continuation of this topic.

HasanCAD, your code is quite peculiar.
Example: you first use the CONVERTPOLY command and then explode all polylines...

To answer your first question:
To avoid skipping entities change line 31 to:

Code: [Select]

(setq ss (ssget ...))
Regarding your second question:
I am sure that if you search the forum you will be able to answer that question yourself.

HasanCAD · « **Reply #2 on:** March 11, 2015, 04:44:57 AM »

Quote from: roy_043 on March 11, 2015, 04:16:02 AM

This is a continuation of this topic.

Sorry for duplicate.

Quote from: roy_043 on March 11, 2015, 04:16:02 AM

HasanCAD, your code is quite peculiar.
Example: you first use the CONVERTPOLY command and then explode all polylines...

Yep I forgot to delete EXPLODE command.
is there any thing else make the code quite peculiar?

Quote from: roy_043 on March 11, 2015, 04:16:02 AM

To answer your first question:
To avoid skipping entities change line 31 to:
Code: [Select]
(setq ss (ssget ...))

Done and working excellent

Quote from: roy_043 on March 11, 2015, 04:16:02 AM

Regarding your second question:
I am sure that if you search the forum you will be able to answer that question yourself.

I am quite confusing in using UNDO command.

Thanks roy_043

roy_043 · « **Reply #3 on:** March 11, 2015, 09:40:09 AM »

Regarding UNDO:
I now see that the sub routines you employ have their own undo handling. Both DimPL and PSimple try to start and end undo groups. This is problematic as nested undo groups are not possible and you typically want a single undo group for a command function.

So as a first step you must remove these existing lines:

Code: [Select]

(command "UNDO" "BEGIN")
(command "UNDO" "END")
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc) ; 3 times.
(vla-endundomark doc) ; 3 times.

Next you can use this pattern for your command function:

Code: [Select]

(defun c:CSZ ( / doc)
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc) ; End possible existing undo group.
  (vla-startundomark doc) ; Start a new undo group.
  
  ; Do your stuff.
  
  (vla-endundomark doc) ; End the undo group.
  (princ)
)

HasanCAD · « **Reply #4 on:** March 11, 2015, 10:54:47 AM »

Quote from: roy_043 on March 11, 2015, 09:40:09 AM

Regarding UNDO:
...

perfect
Thanks roy_043

News:

Author Topic: help modifying a lisp routine (Read 2153 times)

HasanCAD

help modifying a lisp routine

roy_043

Re: help modifying a lisp routine

HasanCAD

Re: help modifying a lisp routine

roy_043

Re: help modifying a lisp routine

HasanCAD

Re: help modifying a lisp routine