Help me to fix an AutoCAD lisp to work with GstarCAD

October 29, 2023

Hi I use this lisp in AutoCADfor a long tome and works fine. I have to change AutoCAD with GstarCAD because the office I work didn't have AutoCAD ....

The problem is that GstarCAD can not support commands

- setpropertyvalue

- getpropertyvalue

The code I use is

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      (setq str (getpropertyvalue (car blklist) "POINT")); the first one
      (foreach blk (cdr blklist); the rest
        (setq str (strcat str " - " (getpropertyvalue blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   (foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

Any ideas how to fix the code?

Thanks

October 30, 2023

Simple my V20 bricscad does not support get set property, go back to using dxf codes with Entget or use VLa-get property eg

(vla-get-layer obj)

(vla-get-insertionpoint blkobj)

(vlax-get blkobj 'insertionpoint)

Use opposite PUT.

October 30, 2023

Hi BIGAL. Thanks for the reply. Can you fix the code?

Thanks

October 30, 2023

Using entget something like this:

Change

;=======================Change block scale 0.01(incase some block is too close) =================
(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink

to

  (setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

You can update the recover block scales part yourself maybe following this?

October 30, 2023

Hi Steven P. I change this part of the code and delete the recover scale but i have this error

An Error : GStarCAD setvar reject: DYNPROMPT 3 occurred.

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================









;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq
      (repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      (setq str (getpropertyvalue (car blklist) "POINT")); the first one
      (foreach blk (cdr blklist); the rest
        (setq str (strcat str " - " (getpropertyvalue blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

Thanks

Edited October 30, 2023 by mhy3sx

October 30, 2023

It might be that there is another get property command somewhere else in the LISP that you might be able to find and have a go at fixing, using the above as a guide.....

Another thing you could do perhaps is add some lines like this in the code

(princ "\nOK to here, point n")

where n is a number - I don't have GstarCAD to check what works and doesn't... but if you can run the code, post where these princ commands are, and also post which one it gets to that might give an idea where the error occurs

Something like this:

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;






;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;



      (repeat startpar.......

October 30, 2023

Hi Steven P.I update the code, but I have enother error

OK To Here, No. 2; error: no function definition: GETPROPERTYVALUE

Any ideas ?

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)
(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;






;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;

(repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      (setq str (getpropertyvalue (car blklist) "POINT")); the first one
      (foreach blk (cdr blklist); the rest
        (setq str (strcat str " - " (getpropertyvalue blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

Thanks

October 30, 2023

You need to use find in your text editor

(setq str (getpropertyvalue (car blklist) "POINT")); the first one

October 30, 2023

Hi BIGAL, I don't know how to fix this code. Is easy to find getpropertyvalue in notepad , but to replace with what?

In GstarCAD lisp some commands is missing

Can you fix this code?

Thanks

October 31, 2023

4 hours ago, mhy3sx said:

replace with what?

he already said that

22 hours ago, BIGAL said:

Simple my V20 bricscad does not support get set property, go back to using dxf codes with Entget or use VLa-get property eg

(vla-get-layer obj)

(vla-get-insertionpoint blkobj)

(vlax-get blkobj 'insertionpoint)

1. (getpropertyvalue ~~~) > if this line doesn't work

2. replace from this > https://help.autodesk.com/view/ACD/2024/ENU/?guid=GUID-8E5913FC-09ED-4C70-AFB7-2431C062E899

3. to this > http://docs.autodesk.com/ACDMAC/2014/ENU/index.html?url=files/GUID-B3F22E35-4666-452F-89C8-5BC15B9E9463.htm,topicNumber=d30e404575

October 31, 2023

Hi exceed , I am not good in lisp , and this code is difficult for me. Can you fix the code to have it as example .

Thanks

October 31, 2023

(setq str (getpropertyvalue (car blklist) "POINT")); the first one
this returns the attribute value with the tag name matching "POINT"

(setq str (strcat str " - " (getpropertyvalue blk "POINT")))
this returns the attribute value with the tag name matching "POINT"

So this is a simple defun that replaces your getproperty of a attribute. save it at start of code.

(defun aH:getatt (blk tagn)
(foreach att (vlax-invoke (vlax-ename->vla-object blk) 'getattributes)
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(ah:getatt (car blklist) "POINT")) ; the first one


(setq str (strcat str " - " (ah:getatt blk "POINT")))

November 3, 2023

Hi BIGAL. I can not understand how to fix the code

Error: invalid argument type: enamep: nil

(defun aH:getatt (blk tagn)
(foreach att (vlax-invoke (vlax-ename->vla-object blk) 'getattributes)
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

(ah:getatt (car blklist) "POINT")) ; the first one


(setq str (strcat str " - " (ah:getatt blk "POINT")))

;==========================================================================================

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)

(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;






;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;

(repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      (setq str (getpropertyvalue (car blklist) "POINT")); the first one
      (foreach blk (cdr blklist); the rest
        (setq str (strcat str " - " (getpropertyvalue blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

Thanks

November 6, 2023

(defun aH:getatt (blk tagn) so get attribute with blkname and tagname.

The block is from say (car (entsel or (ssname ss x

(setq str (aH:getatt blk "Point")

November 6, 2023

Hi BIGAL. Can you fix this code,I can not understand how to do it !!!

Thanks

November 6, 2023

Changed but no idea if ok as need a test dwg.

test.lsp

November 6, 2023

I have this error now

Error: invalid argument type: stringp:

I attach a test.dwg for test

Thanks

test.dwg

November 7, 2023

This fixed 1 problem

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

Can you repost dwg with output, I think you want like 2-3-4-1 area is 12244.

There appears to be a bracket problem.

Edited November 7, 2023 by BIGAL

November 7, 2023

I can not understand. The same error

Error: invalid argument type: stringp:

; https://www.cadtutor.net/forum/topic/78569-help-me-to-fix-an-autocad-lisp-to-work-with-gstarcad/

(defun aH:getatt (blk tagn)
(setq atts (vlax-invoke (vlax-ename->vla-object blk) 'getattributes))
(foreach att atts
(if (= (vla-get-tagstring att) tagn)
(setq str (vla-get-textstring att))
)
)
(princ)
)

;==========================================================================================

(defun c:numtext2 (/ plsel pl pldata txtht startpt startpar verts blklist plobj plarea str)

(command "_layer" "_m" "TEXT_Layout" "_c" "7" "" "")
(command "_.-style" "TopoCAD" "arial.ttf" "0" "1" "0" "n" "n" "n")
  (if
    (and
      (setq plsel (entsel "\nSelect a close polyline : "))
      (setq pldata (entget (setq pl (car plsel))))
      (member '(0 . "LWPOLYLINE") pldata)
      (vlax-curve-isClosed pl)
    ); and
    (progn ; then [selected qualifying object]

;=======================Change block scale 0.01(incase some block is too close) =================
;(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))
;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
;(setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
;=================================================================================================

;================================= first change Steven P ================================================

(setq blkss (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL,STATION,oroikismou"))))

;;(setq blkscl (getpropertyvalue (ssname blkss 0) "ScaleFactors"));
  (setq BlkEnt (entget (ssname blkss 0)))
  (setq BlkScales (list (assoc 41 BlkEnt) (assoc 42 BlkEnt) (assoc 43 BlkEnt))) 

  (setq blklistall (mapcar 'cadr (ssnamex blkss))); selection set to list of entity names
;;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" '(0.01 0.01 0.01))); shrink
  (foreach blkent blklistall
    (setq ed (entget blkent))
    (setq ed (subst (cons 41 0.1) (assoc 41 ed) ed )) ; x scale
    (setq ed (subst (cons 42 0.1) (assoc 42 ed) ed )) ; y scale
    (setq ed (subst (cons 43 0.1) (assoc 43 ed) ed )) ; z scale
    (entmod ed)
  )

;================================================================================================


;;;;----;;;;
(princ "\nOK To Here, No. 1")
;;;;----;;;;


;;;;; NOT HERE!  It doesn't know yet which Space you want the Mtext in!
;===================================text height==================================================
;
;     (if (= (getvar 'ctab) "Model")
;        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
;        (setq txtht 2.5); else  <- Scale in layout
;      ); if
;
;=================================================================================================
      (setvar 'osmode 1); ENDpoint only
      (setq
        startpt (getpoint "\nSelect the first point: ")
        startpar (fix (+ (vlax-curve-getParamAtPoint pl startpt) 0.5))
        verts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) pldata)); list of vertices
        blklist (mapcar 'cadr (ssnamex (ssget "_F" verts '((0 . "INSERT") (66 . 1)))))
          ;; list of Attributed Blocks Polyline intersects in Polyline-drawn sequence
      ); setq



;;;;----;;;;
(princ "\nOK To Here, No. 2")
;;;;----;;;;

(repeat startpar
        (setq blklist (append (cdr blklist) (list (car blklist)))); move first to end
      ); repeat
      (setq
        blklist (append blklist (list (car blklist))); put first on end again
        plobj (vlax-ename->vla-object pl)
        plarea (vla-get-Area plobj)
      ); setq
      (vla-offset plobj 1); temporary for area comparison:
      (setq CW (< (vla-get-Area (vlax-ename->vla-object (entlast))) plarea))
        ;; = drawn ClockWise [T/nil]
      (entdel (entlast)); remove temporary Offset Polyline
      (if (not CW) (setq blklist (reverse blklist)))
      (setq str (aH:getatt (car blklist) "POINT")); the first one
      (foreach blk (cdr blklist); the rest
        (setq str (strcat str " - " (aH:getatt blk "POINT")))
      ); foreach
      (setq str (strcat str " = " (rtos plarea 2 2) " τ.μ."))

;---------------------------------------------------------------;
;                    Change to Paper space                     ;
;---------------------------------------------------------------;
 
(initget "Modelspace Paperspace")
          (setq t_spc
            (cond
              ( (getkword "\nInsert text : [Modelspace/Paperspace] <Modelspace>"))
              ("Modelspace")
            )
          )
          (if (= t_spc "Paperspace") (setvar 'tilemode 0))

;---------------------------------------------------------------------------------------

;;;;; HERE!  Now it knows what Space you're putting the Mtext in
;===================================text height==================================================

      (if (= (getvar 'ctab) "Model")
        (setq txtht (* (getvar "useri1") 0.0025)) ; then  <- Scale in Model Space
        (setq txtht 2.5); else  <- Scale in layout
      ); if

      (command
        "_.mtext" (getvar 'viewctr) "_height" txtht "_width" 0 str ""
        "_.move" "_last" "" "@" pause
      )

;=============================== Recover scale ============================================

   ;(foreach blkent blklistall (setpropertyvalue blkent "ScaleFactors" blkscl)) ;  second change Steven P 

;==============================================================================================

    ); progn [then]
    (prompt "Nothing selected, or not a closed Polyline."); else
  ); if

;==============================================================================================

    (setq SS (ssget "_X" '((2 . "Point,Dianomi,Ktir,DAS,KOROT,KOKAEK,APAL,NAPAL"))))
		(repeat (setq i (sslength SS))
			(setq ent (ssname SS (setq i (1- i))))
			(setq vla-obj (vlax-ename->vla-object ent))
			(if 
				(and
					(or
						(not (= (vla-get-XScaleFactor vla-obj) scf))
						(not (= (vla-get-YScaleFactor vla-obj) scf))
						(not (= (vla-get-ZScaleFactor vla-obj) scf))
					)
					(vlax-property-available-p vla-obj 'EffectiveName)
				)
				(progn
					(vla-put-XScaleFactor vla-obj scf)
					(vlax-put-property vla-obj 'YScaleFactor scf)
					(vlax-put vla-obj 'ZScaleFactor scf)
	                 	)
		    )
		);repeat
		(vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object)) acActiveViewport)
	(princ)

;==============================================================================================

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
)

November 12, 2023

Any options?

Help me to fix an AutoCAD lisp to work with GstarCAD

Recommended Posts

mhy3sx

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhy3sx

BIGAL

Posted Images

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

exceed

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

mhy3sx

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity