Jump to content

Help me to fix an AutoCAD lisp to work with GstarCAD


Recommended Posts

Posted

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

 

Posted

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.

Posted

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

 

Thanks

Posted

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?

Posted (edited)

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 by mhy3sx
Posted

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.......
      

 

Posted

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

Posted

You need to use find in your text editor

 

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

Posted

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

  • Like 1
Posted
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

 

 

Posted

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

Posted
(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")))

 

  • Like 1
Posted

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

Posted

(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")

 

Posted

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

 

Thanks

Posted

I have this error now

 

Error: invalid argument type: stringp: 

 

I attach a test.dwg for test

 

Thanks

test.dwg

Posted (edited)

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 by BIGAL
Posted

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))
)

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...