AutoLISP help - Convert ENTGET to SSGET

Anonymous · ‎08-12-2021

Hello,

Could please someone help me in converting a lisp command from entget to ssget.

This is original lisp function

(defun zso ()
 (setq e (entsel "\nPokazi liniju..."))
 (setq pt1 (cadr e) a (entget (car e)))
 (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
   (zso1)
 )
  (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
   (progn
     (cond ((= bl "DS") (setq mro (* 0.1 fx)))
           ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
           ((or (= bl "CS") (= bl "VS")) (setq mro fx))
           ((= bl "BS") (setq mro (* 1.5 fx)))
           ((= bl "ZS") (setq mro (* 2.5 fx)))
           ((= bl "BGS") (setq mro (* 7.5 fx)))
     )
    (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
    (setq d (distance pt2 pt3))
     (cond ((> d (* 2 rog)) (zso1))
           ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
           ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
     )
  ))
)

On basis of my almost zero in Autolisp knowledge I managed to change it to the below code.

(defun zsoMultiple ()
 (setq sselection (ssget))
 (repeat (setq e (sslength sselection))
  (setq pt1 (cadr e) a (entget (car e)))
  (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
    (zso1)
  )
    (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
    (progn
      (cond ((= bl "DS") (setq mro (* 0.1 fx)))
            ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
            ((or (= bl "CS") (= bl "VS")) (setq mro fx))
            ((= bl "BS") (setq mro (* 1.5 fx)))
            ((= bl "ZS") (setq mro (* 2.5 fx)))
            ((= bl "BGS") (setq mro (* 7.5 fx)))
      )
      (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
      (setq d (distance pt2 pt3))
      (cond ((> d (* 2 rog)) (zso1))
            ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
            ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
      )
    ))
 )
)

But this LISP is not working as expected, Could please someone help me in solving this issue.

Thanks in advance !

Kent1Cooper · ‎08-12-2021

Are you still wanting to select only a single object? Usually one would use (ssget) instead of (entsel) when they want to select multiple objects. But the (prompt) at the end seems appropriate only with a single object selected.

If still a single object, try this:

(defun zso ()
  (prompt "\nPokazi liniju...")
  (if (setq ss (ssget "_:S+." '((0 . "LINE,ARC,LWPOLYLINE"))))
    ;; single selection only, accepting only those entity types
    (progn ; then
      (setq a (entget (ssname ss 0))); entity data list
      (if (wcmatch (cdr (assoc 0 a)) "LWPOLYLINE,ARC")
        (zso1)
      ); if
      (if (= (cdr (assoc 0 a)) "LINE")
        (progn ....
    ;;  ....  what you have in between
            ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
          ); cond
        ); progn
      ); if [it's a Line]
    ); progn
  ); if [qualified object selected]
); defun

That might be done a little differently, depending on what the (zso1) function does.

Kent Cooper, AIA

pbejse · ‎08-12-2021

@Anonymous wrote:

Could please someone help me in converting a lisp command from entget to ssget.

This is original lisp function

There are missing subs (zso1) and (zso2), variables fx and bl is also not defined ,

(defun zso (/ sse e i e mro pt2 pt3)
  (if
    (setq sse (ssget '((0 . "LWPOLYLINE,ARC,LINE"))))
     (repeat (setq i (sslength sse))
       (setq e (ssname sse (setq i (1- i)))
	     a (entget e)
       )
       (if (Eq (Cdr assoc 0 a) "LINE")
	 (progn
	   (cond ((= bl "DS") (setq mro (* 0.1 fx)))
		 ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
		 ((or (= bl "CS") (= bl "VS")) (setq mro fx))
		 ((= bl "BS") (setq mro (* 1.5 fx)))
		 ((= bl "ZS") (setq mro (* 2.5 fx)))
		 ((= bl "BGS") (setq mro (* 7.5 fx)))
	   )
	   (setq pt2 (cdr (assoc 10 a))
		 pt3 (cdr (assoc 11 a))
	   )
	   (setq d (distance pt2 pt3))
	   (cond ((> d (* 2 rog)) (zso1))
		 ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
		 ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
	   )
	 )
	 (zso1)		;<-- not sure if pt1 is actually needed for this sub\
	 		; if it is  please post the missing functions otherwise will use ssnamex
       )
     )
  )
  (princ)
)

HTH

Anonymous · ‎08-12-2021

Thank you for replying...I just wrote down single function which i was trying to convert function "ZIVA" from "Single Select" to "Multiple Select".

; Program za crtanje TZ na iscrtanim linijama i polilinijama
;************************************************************
(defun preks (opis)
 (if (or (= opis "Cancel") (= opis "console break") (= opis "Function cancelled"))
     (prompt "\n...Prekid programa..."))
 (command "LAYER" "S" tl "")
 (setvar "CECOLOR" tce)
 (setq a nil bl nil bl1 nil blk nil d nil e nil lay nil mro nil pt1 nil pt3 nil pt4 nil rm nil
  rog nil tce nil tl nil)
 (setvar "CMDECHO" 1)
 (setq *error* OriGre)
 (prin1)
)

(defun zpcs ()
 (setq OriGre *error* *error* preks)
 (if (/= (getvar "USERI1") 0) (setq fx (* (getvar "USERI1") 0.001)) (setq fx 1))
 (mapcar 'setvar '("CMDECHO" "BLIPMODE" "COORDS" "OSMODE") '(0 0 2 0))
 (setq tce (getvar "CECOLOR") tl (getvar "CLAYER"))
 (setvar "CECOLOR" "bylayer")
)

(defun zkrs ()
 (command "LAYER" "S" tl "")
 (setvar "CECOLOR" tce)
 (setq a nil bl nil bl1 nil blk nil d nil e nil lay nil mro nil pt1 nil pt3 nil pt4 nil rm nil
  rog nil tce nil tl nil)
 (setvar "CMDECHO" 1)
 (setq *error* OriGre)
 (prin1)
)

(defun zso1 ()
 (command "MEASURE" pt1 "block" bl "" rog)
 (initget "Da Ne")
 (setq rm (getint (strcat "\nDobro iscrtani znaci? Ne <Da>: ")))
  (if (= rm "Ne")
   (progn
    (command "U")
    (command "U")
    (command "LAYER" "S" tll "")
    (command "MEASURE" pt1 "block" bl1 "" rog)
  ))
)

(defun zso2 ()
 (setq pt4 (polar pt2 (angle pt2 pt3) (* d 0.5)))
 (command "INSERT" bl pt4 "" "" (atof (angtos (angle pt2 pt3) 0 8)))
 (initget "Da Ne")
 (setq rm (getint (strcat "\nDobro iscrtani znaci? Ne <Da>: ")))
  (if (= rm "Ne")
   (progn
    (command "U")
    (command "U")
    (command "LAYER" "S" tll "")
    (command "INSERT" bl1 pt4 "" "" (atof (angtos (angle pt2 pt3) 0 8)))
  ))
)

(defun zso ()
 (setq e (entsel "\nPokazi liniju..."))
 (setq pt1 (cadr e) a (entget (car e)))
 (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
   (zso1)
 )
  (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
   (progn
     (cond ((= bl "DS") (setq mro (* 0.1 fx)))
           ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
           ((or (= bl "CS") (= bl "VS")) (setq mro fx))
           ((= bl "BS") (setq mro (* 1.5 fx)))
           ((= bl "ZS") (setq mro (* 2.5 fx)))
           ((= bl "BGS") (setq mro (* 7.5 fx)))
     )
    (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
    (setq d (distance pt2 pt3))
     (cond ((> d (* 2 rog)) (zso1))
           ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
           ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
     )
  ))
)

(defun yzso ()
 (setq sselection (ssget))
 (repeat (setq e (sslength sselection))
  (setq pt1 (cadr e) a (entget (car e)))
  (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
    (zso1)
  )
    (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
    (progn
      (cond ((= bl "DS") (setq mro (* 0.1 fx)))
            ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
            ((or (= bl "CS") (= bl "VS")) (setq mro fx))
            ((= bl "BS") (setq mro (* 1.5 fx)))
            ((= bl "ZS") (setq mro (* 2.5 fx)))
            ((= bl "BGS") (setq mro (* 7.5 fx)))
      )
      (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
      (setq d (distance pt2 pt3))
      (cond ((> d (* 2 rog)) (zso1))
            ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
            ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
      )
    ))
 )
)

(defun C:ZICANA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_ZICANA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_ZICANA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "OGRADA_ZICANA"))
    (if (/= lay nil) (command "LAYER" "S" "OGRADA_ZICANA" "") (command "LAYER" "M" "OGRADA_ZICANA" ""))
    (setq tll "OGRADA_ZICANA2")
    (setq bl "OGRADA_ZICANA2" bl1 "OGRADA_ZICANA2" rog (* fx 8))
    (prompt "\n*** TZ za ZICANU OGRADU na iscrtanim linijama i polilinijama ***")
    (zso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

(defun C:ZIVA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_ZIVA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_ZIVA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "OGRADA_ZIVA"))
    (if (/= lay nil) (command "LAYER" "S" "OGRADA_ZIVA" "") (command "LAYER" "M" "OGRADA_ZIVA" ""))
    (setq tll "OGRADA_ZIVA2")
    (setq bl "OGRADA_ZIVA2" bl1 "OGRADA_ZIVA2" rog (* fx 8))
    (prompt "\n*** TZ za ZIVU OGRADU iscrtanim linijama i polilinijama ***")
    (yzso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

(defun C:GVOZDENA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_GVOZDENA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_GVOZDENA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "OGRADA_GVOZDENA"))
    (if (/= lay nil) (command "LAYER" "S" "OGRADA_GVOZDENA" "") (command "LAYER" "M" "OGRADA_GVOZDENA" ""))
    (setq tll "OGRADA_GVOZDENA2")
    (setq bl "OGRADA_GVOZDENA2" bl1 "OGRADA_GVOZDENA2" rog (* fx 8))
    (prompt "\n*** TZ za GVOZDENU OGRADU iscrtanim linijama i polilinijama ***")
    (zso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

(defun C:ZIDANA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_ZIDANA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_ZIDANA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "OGRADA_ZIDANA"))
    (if (/= lay nil) (command "LAYER" "S" "OGRADA_ZIDANA" "") (command "LAYER" "M" "OGRADA_ZIDANA" ""))
    (setq tll "OGRADA_ZIDANA2")
    (setq bl "OGRADA_ZIDANA2" bl1 "OGRADA_ZIDANA2" rog (* fx 8))
    (prompt "\n*** TZ za ZIDANU OGRADU iscrtanim linijama i polilinijama ***")
    (zso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

(defun C:DRVENA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_DRVENA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_DRVENA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "OGRADA_DRVENA"))
    (if (/= lay nil) (command "LAYER" "S" "OGRADA_DRVENA" "") (command "LAYER" "M" "OGRADA_DRVENA" ""))
    (setq tll "OGRADA_DRVENA2")
    (setq bl "OGRADA_DRVENA2" bl1 "OGRADA_DRVENA2" rog (* fx 8))
    (prompt "\n*** TZ za DRVENU OGRADU iscrtanim linijama i polilinijama ***")
    (zso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

(defun C:ZASTITNA ()
 (zpcs)
 (setq blk (tblsearch "BLOCK" "OGRADA_ZASTITNA2"))
 (if (/= blk nil) (setq blk (tblsearch "BLOCK" "OGRADA_ZASTITNA2")))
  (if (/= blk nil)
   (progn
    (setq lay (tblsearch "LAYER" "Ograda_zastitna"))
    (if (/= lay nil) (command "LAYER" "S" "Ograda_zastitna" "") (command "LAYER" "M" "Ograda_zastitna" ""))
    (setq tll "OGRADA_ZASTITNA2")
    (setq bl "OGRADA_ZASTITNA2" bl1 "OGRADA_ZASTITNA2" rog (* fx 2.5))
    (prompt "\n*** TZ za ZASTITNU OGRADU iscrtanim linijama i polilinijama ***")
    (zso)
  ))
 (if (= blk nil) (prompt "\nTopografski znaci nisu uneti u crtez!"))
 (zkrs)
)

Anonymous · ‎08-12-2021

I still want a Multiple select version. I think i missed out details while posting in the forum. Now i have edited with the complete LISP. I am trying to run function ZIVA

Kent1Cooper · ‎08-12-2021

@Anonymous wrote:

.... I am trying to run function ZIVA

ZIVA does not involve object selection within itself, so it must be about the (yzso) function that it calls if the Block is present. If (yzso) is adjusted to allow mutliple selection, how should it handle the possibility of the (prompt) near the end when some, but not all, objects may trigger that prompt?

By the way, ZIVA can be considerably simplified:

(defun C:ZIVA ()
  (zpcs)
  (if (setq blk (tblsearch "BLOCK" "OGRADA_ZIVA2"))
    (progn ; then
      (command "LAYER" "M" "OGRADA_ZIVA" "")
      (setq tll "OGRADA_ZIVA2")
      (setq bl "OGRADA_ZIVA2" bl1 "OGRADA_ZIVA2" rog (* fx 8))
      (prompt "\n*** TZ za ZIVU OGRADU iscrtanim linijama i polilinijama ***")
      (yzso)
    ); progn
    (prompt "\nTopografski znaci nisu uneti u crtez!"); else
  ); if
  (zkrs)
)

Kent Cooper, AIA

Kent1Cooper · ‎08-12-2021

@Kent1Cooper wrote:
.... ZIVA can be considerably simplified:
....
      (setq tll "OGRADA_ZIVA2")
      (setq bl "OGRADA_ZIVA2" bl1 "OGRADA_ZIVA2" rog (* fx 8))
....

Even further, actually:

....
(setq tll "OGRADA_ZIVA2" bl tll bl1 tll rog (* fx 8))
....

Kent Cooper, AIA

CADaSchtroumpf · ‎08-13-2021

But this LISP is not working as expected, Could please someone help me in solving this issue.

Thanks in advance !

(defun zsoMultiple ()
 (setq sselection (ssget))
 (repeat (setq e (sslength sselection))
  (setq pt1 (cadr e) a (entget (car e)))
  (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
    (zso1)
  )
    (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
    (progn
      (cond ((= bl "DS") (setq mro (* 0.1 fx)))
            ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
            ((or (= bl "CS") (= bl "VS")) (setq mro fx))
            ((= bl "BS") (setq mro (* 1.5 fx)))
            ((= bl "ZS") (setq mro (* 2.5 fx)))
            ((= bl "BGS") (setq mro (* 7.5 fx)))
      )
      (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
      (setq d (distance pt2 pt3))
      (cond ((> d (* 2 rog)) (zso1))
            ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
            ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
      )
    ))
 )
)

Your handwriting is fake, here is the modification that might work!

(defun zsoMultiple ()
 (princ "\nPokazi liniju...")
 (setq sselection (ssget))
 (repeat (setq e (sslength sselection))
  (setq a (entget (ssname sselection (setq e (1- e)))) pt1 (vlax-curve-getPointAtParam (cdar a) (* 0.5 (vlax-curve-getEndParam (cdar a)))))
  (if (and (/= pt1 nil) (or (= (cdr (assoc 0 a)) "LWPOLYLINE") (= (cdr (assoc 0 a)) "ARC")))
    (zso1)
  )
    (if (and (/= pt1 nil) (= (cdr (assoc 0 a)) "LINE"))
    (progn
      (cond ((= bl "DS") (setq mro (* 0.1 fx)))
            ((or (= bl "GS") (= bl "OS")) (setq mro (* 2 fx)))
            ((or (= bl "CS") (= bl "VS")) (setq mro fx))
            ((= bl "BS") (setq mro (* 1.5 fx)))
            ((= bl "ZS") (setq mro (* 2.5 fx)))
            ((= bl "BGS") (setq mro (* 7.5 fx)))
      )
      (setq pt2 (cdr (assoc 10 a)) pt3 (cdr (assoc 11 a)))
      (setq d (distance pt2 pt3))
      (cond ((> d (* 2 rog)) (zso1))
            ((and (<= d (* 2 rog)) (>= d mro)) (zso2))
            ((< d mro) (prompt "\nDuzina fronta je manja od TZ"))
      )
    ))
 )
)

Community

AutoLISP help - Convert ENTGET to SSGET

AutoLISP help - Convert ENTGET to SSGET

AutoLISP help - Convert ENTGET to SSGET